summaryrefslogtreecommitdiffstats
path: root/libgfortran
diff options
context:
space:
mode:
authorThomas Koenig <tkoenig@gcc.gnu.org>2022-01-09 16:35:21 +0100
committerJakub Jelinek <jakub@redhat.com>2022-01-11 23:49:52 +0100
commit9840285d877c5820d75d1347fc2a4f176ab31b11 (patch)
treed26cdaba1d95d45635a068634a0b4285e3c1c813 /libgfortran
parentlibgfortran: Make sure glibc < 2.32 built powerpc64le-linux libgfortran doesn... (diff)
downloadgcc-9840285d877c5820d75d1347fc2a4f176ab31b11.tar.gz
gcc-9840285d877c5820d75d1347fc2a4f176ab31b11.tar.bz2
gcc-9840285d877c5820d75d1347fc2a4f176ab31b11.tar.xz
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.
Diffstat (limited to 'libgfortran')
-rw-r--r--libgfortran/Makefile.in1
-rw-r--r--libgfortran/io/file_pos.c7
-rw-r--r--libgfortran/io/inquire.c18
-rw-r--r--libgfortran/io/open.c33
-rw-r--r--libgfortran/io/transfer.c127
5 files changed, 174 insertions, 12 deletions
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index fa5e21578c8..cf500a002e8 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -719,6 +719,7 @@ pdfdir = @pdfdir@
719prefix = @prefix@ 719prefix = @prefix@
720program_transform_name = @program_transform_name@ 720program_transform_name = @program_transform_name@
721psdir = @psdir@ 721psdir = @psdir@
722runstatedir = @runstatedir@
722sbindir = @sbindir@ 723sbindir = @sbindir@
723sharedstatedir = @sharedstatedir@ 724sharedstatedir = @sharedstatedir@
724srcdir = @srcdir@ 725srcdir = @srcdir@
diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index 45db53496e4..18b1feaefc4 100644
--- a/libgfortran/io/file_pos.c
+++ b/libgfortran/io/file_pos.c
@@ -104,6 +104,11 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
104 ssize_t length; 104 ssize_t length;
105 int continued; 105 int continued;
106 char p[sizeof (GFC_INTEGER_8)]; 106 char p[sizeof (GFC_INTEGER_8)];
107 int convert = u->flags.convert;
108
109#ifdef HAVE_GFC_REAL_17
110 convert &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
111#endif
107 112
108 if (compile_options.record_marker == 0) 113 if (compile_options.record_marker == 0)
109 length = sizeof (GFC_INTEGER_4); 114 length = sizeof (GFC_INTEGER_4);
@@ -119,7 +124,7 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
119 goto io_error; 124 goto io_error;
120 125
121 /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ 126 /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */
122 if (likely (u->flags.convert == GFC_CONVERT_NATIVE)) 127 if (likely (convert == GFC_CONVERT_NATIVE))
123 { 128 {
124 switch (length) 129 switch (length)
125 { 130 {
diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index 600e979a642..e42f2eb6628 100644
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -642,6 +642,24 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit *u)
642 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN" : "BIG_ENDIAN"; 642 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
643 break; 643 break;
644 644
645#ifdef HAVE_GFC_REAL_17
646 case GFC_CONVERT_NATIVE | GFC_CONVERT_R16_IEEE:
647 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "BIG_ENDIAN,R16_IEEE" : "LITTLE_ENDIAN,R16_IEEE";
648 break;
649
650 case GFC_CONVERT_SWAP | GFC_CONVERT_R16_IEEE:
651 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN,R16_IEEE" : "BIG_ENDIAN,R16_IEEE";
652 break;
653
654 case GFC_CONVERT_NATIVE | GFC_CONVERT_R16_IBM:
655 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "BIG_ENDIAN,R16_IBM" : "LITTLE_ENDIAN,R16_IBM";
656 break;
657
658 case GFC_CONVERT_SWAP | GFC_CONVERT_R16_IBM:
659 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN,R16_IBM" : "BIG_ENDIAN,R16_IBM";
660 break;
661#endif
662
645 default: 663 default:
646 internal_error (&iqp->common, "inquire_via_unit(): Bad convert"); 664 internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
647 } 665 }
diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index dfa04d0a805..c9276c72748 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -153,6 +153,28 @@ static const st_option convert_opt[] =
153 { "swap", GFC_CONVERT_SWAP}, 153 { "swap", GFC_CONVERT_SWAP},
154 { "big_endian", GFC_CONVERT_BIG}, 154 { "big_endian", GFC_CONVERT_BIG},
155 { "little_endian", GFC_CONVERT_LITTLE}, 155 { "little_endian", GFC_CONVERT_LITTLE},
156#ifdef HAVE_GFC_REAL_17
157 /* Rather than write a special parsing routine, enumerate all the
158 possibilities here. */
159 { "r16_ieee", GFC_CONVERT_R16_IEEE},
160 { "r16_ibm", GFC_CONVERT_R16_IBM},
161 { "native,r16_ieee", GFC_CONVERT_R16_IEEE},
162 { "native,r16_ibm", GFC_CONVERT_R16_IBM},
163 { "r16_ieee,native", GFC_CONVERT_R16_IEEE},
164 { "r16_ibm,native", GFC_CONVERT_R16_IBM},
165 { "swap,r16_ieee", GFC_CONVERT_R16_IEEE_SWAP},
166 { "swap,r16_ibm", GFC_CONVERT_R16_IBM_SWAP},
167 { "r16_ieee,swap", GFC_CONVERT_R16_IEEE_SWAP},
168 { "r16_ibm,swap", GFC_CONVERT_R16_IBM_SWAP},
169 { "big_endian,r16_ieee", GFC_CONVERT_R16_IEEE_BIG},
170 { "big_endian,r16_ibm", GFC_CONVERT_R16_IBM_BIG},
171 { "r16_ieee,big_endian", GFC_CONVERT_R16_IEEE_BIG},
172 { "r16_ibm,big_endian", GFC_CONVERT_R16_IBM_BIG},
173 { "little_endian,r16_ieee", GFC_CONVERT_R16_IEEE_LITTLE},
174 { "little_endian,r16_ibm", GFC_CONVERT_R16_IBM_LITTLE},
175 { "r16_ieee,little_endian", GFC_CONVERT_R16_IEEE_LITTLE},
176 { "r16_ibm,little_endian", GFC_CONVERT_R16_IBM_LITTLE},
177#endif
156 { NULL, 0} 178 { NULL, 0}
157}; 179};
158 180
@@ -820,7 +842,14 @@ st_open (st_parameter_open *opp)
820 else 842 else
821 conv = compile_options.convert; 843 conv = compile_options.convert;
822 } 844 }
823 845
846 flags.convert = 0;
847
848#ifdef HAVE_GFC_REAL_17
849 flags.convert = conv & (GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
850 conv &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
851#endif
852
824 switch (conv) 853 switch (conv)
825 { 854 {
826 case GFC_CONVERT_NATIVE: 855 case GFC_CONVERT_NATIVE:
@@ -840,7 +869,7 @@ st_open (st_parameter_open *opp)
840 break; 869 break;
841 } 870 }
842 871
843 flags.convert = conv; 872 flags.convert |= conv;
844 873
845 if (flags.position != POSITION_UNSPECIFIED 874 if (flags.position != POSITION_UNSPECIFIED
846 && flags.access == ACCESS_DIRECT) 875 && flags.access == ACCESS_DIRECT)
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index a57eb676c2f..8e4f64db177 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -1088,6 +1088,8 @@ static void
1088unformatted_read (st_parameter_dt *dtp, bt type, 1088unformatted_read (st_parameter_dt *dtp, bt type,
1089 void *dest, int kind, size_t size, size_t nelems) 1089 void *dest, int kind, size_t size, size_t nelems)
1090{ 1090{
1091 unit_convert convert;
1092
1091 if (type == BT_CLASS) 1093 if (type == BT_CLASS)
1092 { 1094 {
1093 int unit = dtp->u.p.current_unit->unit_number; 1095 int unit = dtp->u.p.current_unit->unit_number;
@@ -1126,8 +1128,8 @@ unformatted_read (st_parameter_dt *dtp, bt type,
1126 size *= GFC_SIZE_OF_CHAR_KIND(kind); 1128 size *= GFC_SIZE_OF_CHAR_KIND(kind);
1127 read_block_direct (dtp, dest, size * nelems); 1129 read_block_direct (dtp, dest, size * nelems);
1128 1130
1129 if (unlikely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_SWAP) 1131 convert = dtp->u.p.current_unit->flags.convert;
1130 && kind != 1) 1132 if (unlikely (convert != GFC_CONVERT_NATIVE) && kind != 1)
1131 { 1133 {
1132 /* Handle wide chracters. */ 1134 /* Handle wide chracters. */
1133 if (type == BT_CHARACTER) 1135 if (type == BT_CHARACTER)
@@ -1142,7 +1144,50 @@ unformatted_read (st_parameter_dt *dtp, bt type,
1142 nelems *= 2; 1144 nelems *= 2;
1143 size /= 2; 1145 size /= 2;
1144 } 1146 }
1147#ifndef HAVE_GFC_REAL_17
1145 bswap_array (dest, dest, size, nelems); 1148 bswap_array (dest, dest, size, nelems);
1149#else
1150 unit_convert bswap = convert & ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
1151 if (bswap == GFC_CONVERT_SWAP)
1152 bswap_array (dest, dest, size, nelems);
1153
1154 if ((convert & GFC_CONVERT_R16_IEEE)
1155 && kind == 16
1156 && (type == BT_REAL || type == BT_COMPLEX))
1157 {
1158 char *pd = dest;
1159 for (size_t i = 0; i < nelems; i++)
1160 {
1161 GFC_REAL_16 r16;
1162 GFC_REAL_17 r17;
1163 memcpy (&r17, pd, 16);
1164 r16 = r17;
1165 memcpy (pd, &r16, 16);
1166 pd += size;
1167 }
1168 }
1169 else if ((dtp->u.p.current_unit->flags.convert & GFC_CONVERT_R16_IBM)
1170 && kind == 17
1171 && (type == BT_REAL || type == BT_COMPLEX))
1172 {
1173 if (type == BT_COMPLEX && size == 32)
1174 {
1175 nelems *= 2;
1176 size /= 2;
1177 }
1178
1179 char *pd = dest;
1180 for (size_t i = 0; i < nelems; i++)
1181 {
1182 GFC_REAL_16 r16;
1183 GFC_REAL_17 r17;
1184 memcpy (&r16, pd, 16);
1185 r17 = r16;
1186 memcpy (pd, &r17, 16);
1187 pd += size;
1188 }
1189 }
1190#endif /* HAVE_GFC_REAL_17. */
1146 } 1191 }
1147} 1192}
1148 1193
@@ -1156,6 +1201,8 @@ static void
1156unformatted_write (st_parameter_dt *dtp, bt type, 1201unformatted_write (st_parameter_dt *dtp, bt type,
1157 void *source, int kind, size_t size, size_t nelems) 1202 void *source, int kind, size_t size, size_t nelems)
1158{ 1203{
1204 unit_convert convert;
1205
1159 if (type == BT_CLASS) 1206 if (type == BT_CLASS)
1160 { 1207 {
1161 int unit = dtp->u.p.current_unit->unit_number; 1208 int unit = dtp->u.p.current_unit->unit_number;
@@ -1190,8 +1237,14 @@ unformatted_write (st_parameter_dt *dtp, bt type,
1190 return; 1237 return;
1191 } 1238 }
1192 1239
1193 if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE) 1240 convert = dtp->u.p.current_unit->flags.convert;
1194 || kind == 1) 1241 if (likely (convert == GFC_CONVERT_NATIVE) || kind == 1
1242#ifdef HAVE_GFC_REAL_17
1243 || ((type == BT_REAL || type == BT_COMPLEX)
1244 && ((kind == 16 && convert == GFC_CONVERT_R16_IBM)
1245 || (kind == 17 && convert == GFC_CONVERT_R16_IEEE)))
1246#endif
1247 )
1195 { 1248 {
1196 size_t stride = type == BT_CHARACTER ? 1249 size_t stride = type == BT_CHARACTER ?
1197 size * GFC_SIZE_OF_CHAR_KIND(kind) : size; 1250 size * GFC_SIZE_OF_CHAR_KIND(kind) : size;
@@ -1233,9 +1286,50 @@ unformatted_write (st_parameter_dt *dtp, bt type,
1233 else 1286 else
1234 nc = nrem; 1287 nc = nrem;
1235 1288
1236 bswap_array (buffer, p, size, nc); 1289#ifdef HAVE_GFC_REAL_17
1290 if ((dtp->u.p.current_unit->flags.convert & GFC_CONVERT_R16_IEEE)
1291 && kind == 16
1292 && (type == BT_REAL || type == BT_COMPLEX))
1293 {
1294 for (size_t i = 0; i < nc; i++)
1295 {
1296 GFC_REAL_16 r16;
1297 GFC_REAL_17 r17;
1298 memcpy (&r16, p, 16);
1299 r17 = r16;
1300 memcpy (&buffer[i * 16], &r17, 16);
1301 p += 16;
1302 }
1303 if ((dtp->u.p.current_unit->flags.convert
1304 & ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM))
1305 == GFC_CONVERT_SWAP)
1306 bswap_array (buffer, buffer, size, nc);
1307 }
1308 else if ((dtp->u.p.current_unit->flags.convert & GFC_CONVERT_R16_IBM)
1309 && kind == 17
1310 && (type == BT_REAL || type == BT_COMPLEX))
1311 {
1312 for (size_t i = 0; i < nc; i++)
1313 {
1314 GFC_REAL_16 r16;
1315 GFC_REAL_17 r17;
1316 memcpy (&r17, p, 16);
1317 r16 = r17;
1318 memcpy (&buffer[i * 16], &r16, 16);
1319 p += 16;
1320 }
1321 if ((dtp->u.p.current_unit->flags.convert
1322 & ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM))
1323 == GFC_CONVERT_SWAP)
1324 bswap_array (buffer, buffer, size, nc);
1325 }
1326 else
1327#endif
1328 {
1329 bswap_array (buffer, p, size, nc);
1330 p += size * nc;
1331 }
1237 write_buf (dtp, buffer, size * nc); 1332 write_buf (dtp, buffer, size * nc);
1238 p += size * nc;
1239 nrem -= nc; 1333 nrem -= nc;
1240 } 1334 }
1241 while (nrem > 0); 1335 while (nrem > 0);
@@ -2691,8 +2785,12 @@ us_read (st_parameter_dt *dtp, int continued)
2691 return; 2785 return;
2692 } 2786 }
2693 2787
2788 int convert = dtp->u.p.current_unit->flags.convert;
2789#ifdef HAVE_GFC_REAL_17
2790 convert &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
2791#endif
2694 /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ 2792 /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */
2695 if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE)) 2793 if (likely (convert == GFC_CONVERT_NATIVE))
2696 { 2794 {
2697 switch (nr) 2795 switch (nr)
2698 { 2796 {
@@ -2894,6 +2992,13 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
2894 if (conv == GFC_CONVERT_NONE) 2992 if (conv == GFC_CONVERT_NONE)
2895 conv = compile_options.convert; 2993 conv = compile_options.convert;
2896 2994
2995 u_flags.convert = 0;
2996
2997#ifdef HAVE_GFC_REAL_17
2998 u_flags.convert = conv & (GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
2999 conv &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
3000#endif
3001
2897 switch (conv) 3002 switch (conv)
2898 { 3003 {
2899 case GFC_CONVERT_NATIVE: 3004 case GFC_CONVERT_NATIVE:
@@ -2913,7 +3018,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
2913 break; 3018 break;
2914 } 3019 }
2915 3020
2916 u_flags.convert = conv; 3021 u_flags.convert |= conv;
2917 3022
2918 opp.common = dtp->common; 3023 opp.common = dtp->common;
2919 opp.common.flags &= IOPARM_COMMON_MASK; 3024 opp.common.flags &= IOPARM_COMMON_MASK;
@@ -3710,8 +3815,12 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf)
3710 else 3815 else
3711 len = compile_options.record_marker; 3816 len = compile_options.record_marker;
3712 3817
3818 int convert = dtp->u.p.current_unit->flags.convert;
3819#ifdef HAVE_GFC_REAL_17
3820 convert &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
3821#endif
3713 /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ 3822 /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */
3714 if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE)) 3823 if (likely (convert == GFC_CONVERT_NATIVE))
3715 { 3824 {
3716 switch (len) 3825 switch (len)
3717 { 3826 {