1 /* Copyright (C) 2002-2024 Free Software Foundation, Inc.
2 Contributed by Andy Vaught
3 F2003 I/O support contributed by Jerry DeLisle
5 This file is part of the GNU Fortran runtime library (libgfortran).
7 Libgfortran is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3, or (at your option)
12 Libgfortran is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 Under Section 7 of GPL version 3, you are granted additional
18 permissions described in the GCC Runtime Library Exception, version
19 3.1, as published by the Free Software Foundation.
21 You should have received a copy of the GNU General Public License and
22 a copy of the GCC Runtime Library Exception along with this program;
23 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24 <http://www.gnu.org/licenses/>. */
34 typedef unsigned char uchar
;
36 /* read.c -- Deal with formatted reads */
39 /* set_integer()-- All of the integer assignments come here to
40 actually place the value into memory. */
43 set_integer (void *dest
, GFC_INTEGER_LARGEST value
, int length
)
45 NOTE ("set_integer: %lld %p", (long long int) value
, dest
);
48 #ifdef HAVE_GFC_INTEGER_16
49 #ifdef HAVE_GFC_REAL_17
52 GFC_INTEGER_16 tmp
= value
;
53 memcpy (dest
, (void *) &tmp
, 16);
57 /* length=10 comes about for kind=10 real/complex BOZ, cf. PR41711. */
61 GFC_INTEGER_16 tmp
= value
;
62 memcpy (dest
, (void *) &tmp
, length
);
68 GFC_INTEGER_8 tmp
= value
;
69 memcpy (dest
, (void *) &tmp
, length
);
74 GFC_INTEGER_4 tmp
= value
;
75 memcpy (dest
, (void *) &tmp
, length
);
80 GFC_INTEGER_2 tmp
= value
;
81 memcpy (dest
, (void *) &tmp
, length
);
86 GFC_INTEGER_1 tmp
= value
;
87 memcpy (dest
, (void *) &tmp
, length
);
91 internal_error (NULL
, "Bad integer kind");
96 /* Max signed value of size give by length argument. */
101 #if defined HAVE_GFC_REAL_16 || defined HAVE_GFC_REAL_10
102 GFC_UINTEGER_LARGEST value
;
107 #if defined HAVE_GFC_REAL_17
110 for (int n
= 1; n
< 4 * 16; n
++)
111 value
= (value
<< 2) + 3;
114 #if defined HAVE_GFC_REAL_16 || defined HAVE_GFC_REAL_10
118 for (int n
= 1; n
< 4 * length
; n
++)
119 value
= (value
<< 2) + 3;
123 return GFC_INTEGER_8_HUGE
;
125 return GFC_INTEGER_4_HUGE
;
127 return GFC_INTEGER_2_HUGE
;
129 return GFC_INTEGER_1_HUGE
;
131 internal_error (NULL
, "Bad integer kind");
136 /* convert_real()-- Convert a character representation of a floating
137 point number to the machine number. Returns nonzero if there is an
138 invalid input. Note: many architectures (e.g. IA-64, HP-PA)
139 require that the storage pointed to by the dest argument is
140 properly aligned for the type in question. */
143 convert_real (st_parameter_dt
*dtp
, void *dest
, const char *buffer
, int length
)
146 int round_mode
, old_round_mode
;
148 switch (dtp
->u
.p
.current_unit
->round_status
)
150 case ROUND_COMPATIBLE
:
151 /* FIXME: As NEAREST but round away from zero for a tie. */
152 case ROUND_UNSPECIFIED
:
153 /* Should not occur. */
154 case ROUND_PROCDEFINED
:
155 round_mode
= ROUND_NEAREST
;
158 round_mode
= dtp
->u
.p
.current_unit
->round_status
;
162 old_round_mode
= get_fpu_rounding_mode();
163 set_fpu_rounding_mode (round_mode
);
168 *((GFC_REAL_4
*) dest
) =
169 #if defined(HAVE_STRTOF)
170 gfc_strtof (buffer
, &endptr
);
172 (GFC_REAL_4
) gfc_strtod (buffer
, &endptr
);
177 *((GFC_REAL_8
*) dest
) = gfc_strtod (buffer
, &endptr
);
180 #if defined(HAVE_GFC_REAL_10) && defined (HAVE_STRTOLD)
182 *((GFC_REAL_10
*) dest
) = gfc_strtold (buffer
, &endptr
);
186 #if defined(HAVE_GFC_REAL_16)
187 # if defined(GFC_REAL_16_IS_FLOAT128)
189 # if defined(GFC_REAL_16_USE_IEC_60559)
190 *((GFC_REAL_16
*) dest
) = strtof128 (buffer
, &endptr
);
192 *((GFC_REAL_16
*) dest
) = __qmath_(strtoflt128
) (buffer
, &endptr
);
195 # elif defined(HAVE_STRTOLD)
197 *((GFC_REAL_16
*) dest
) = gfc_strtold (buffer
, &endptr
);
202 #if defined(HAVE_GFC_REAL_17)
204 # if defined(POWER_IEEE128)
205 *((GFC_REAL_17
*) dest
) = __strtoieee128 (buffer
, &endptr
);
206 # elif defined(GFC_REAL_17_USE_IEC_60559)
207 *((GFC_REAL_17
*) dest
) = strtof128 (buffer
, &endptr
);
209 *((GFC_REAL_17
*) dest
) = __qmath_(strtoflt128
) (buffer
, &endptr
);
215 internal_error (&dtp
->common
, "Unsupported real kind during IO");
218 set_fpu_rounding_mode (old_round_mode
);
220 if (buffer
== endptr
)
222 generate_error (&dtp
->common
, LIBERROR_READ_VALUE
,
223 "Error during floating point read");
224 next_record (dtp
, 1);
231 /* convert_infnan()-- Convert character INF/NAN representation to the
232 machine number. Note: many architectures (e.g. IA-64, HP-PA) require
233 that the storage pointed to by the dest argument is properly aligned
234 for the type in question. */
237 convert_infnan (st_parameter_dt
*dtp
, void *dest
, const char *buffer
,
240 const char *s
= buffer
;
241 int is_inf
, plus
= 1;
257 *((GFC_REAL_4
*) dest
) = plus
? __builtin_inff () : -__builtin_inff ();
259 *((GFC_REAL_4
*) dest
) = plus
? __builtin_nanf ("") : -__builtin_nanf ("");
264 *((GFC_REAL_8
*) dest
) = plus
? __builtin_inf () : -__builtin_inf ();
266 *((GFC_REAL_8
*) dest
) = plus
? __builtin_nan ("") : -__builtin_nan ("");
269 #if defined(HAVE_GFC_REAL_10)
272 *((GFC_REAL_10
*) dest
) = plus
? __builtin_infl () : -__builtin_infl ();
274 *((GFC_REAL_10
*) dest
) = plus
? __builtin_nanl ("") : -__builtin_nanl ("");
278 #if defined(HAVE_GFC_REAL_16)
279 # if defined(GFC_REAL_16_IS_FLOAT128)
281 # if defined(GFC_REAL_16_USE_IEC_60559)
283 *((GFC_REAL_16
*) dest
) = plus
? __builtin_inff128 () : -__builtin_inff128 ();
285 *((GFC_REAL_16
*) dest
) = plus
? __builtin_nanf128 ("") : -__builtin_nanf128 ("");
287 *((GFC_REAL_16
*) dest
) = __qmath_(strtoflt128
) (buffer
, NULL
);
293 *((GFC_REAL_16
*) dest
) = plus
? __builtin_infl () : -__builtin_infl ();
295 *((GFC_REAL_16
*) dest
) = plus
? __builtin_nanl ("") : -__builtin_nanl ("");
300 #if defined(HAVE_GFC_REAL_17)
303 *((GFC_REAL_17
*) dest
) = plus
? __builtin_infl () : -__builtin_infl ();
305 *((GFC_REAL_17
*) dest
) = plus
? __builtin_nanl ("") : -__builtin_nanl ("");
310 internal_error (&dtp
->common
, "Unsupported real kind during IO");
317 /* read_l()-- Read a logical value */
320 read_l (st_parameter_dt
*dtp
, const fnode
*f
, char *dest
, int length
)
327 p
= read_block_form (dtp
, &w
);
350 set_integer (dest
, (GFC_INTEGER_LARGEST
) 1, length
);
354 set_integer (dest
, (GFC_INTEGER_LARGEST
) 0, length
);
358 generate_error (&dtp
->common
, LIBERROR_READ_VALUE
,
359 "Bad value on logical read");
360 next_record (dtp
, 1);
367 read_utf8 (st_parameter_dt
*dtp
, size_t *nbytes
)
369 static const uchar masks
[6] = { 0x7F, 0x1F, 0x0F, 0x07, 0x02, 0x01 };
370 static const uchar patns
[6] = { 0x00, 0xC0, 0xE0, 0xF0, 0xF8, 0xFC };
377 s
= read_block_form (dtp
, nbytes
);
381 /* If this is a short read, just return. */
389 /* The number of leading 1-bits in the first byte indicates how many
391 for (nb
= 2; nb
< 7; nb
++)
392 if ((c
& ~masks
[nb
-1]) == patns
[nb
-1])
397 c
= (c
& masks
[nb
-1]);
400 s
= read_block_form (dtp
, &nread
);
403 /* Decode the bytes read. */
404 for (size_t i
= 1; i
< nb
; i
++)
406 gfc_char4_t n
= *s
++;
408 if ((n
& 0xC0) != 0x80)
411 c
= ((c
<< 6) + (n
& 0x3F));
414 /* Make sure the shortest possible encoding was used. */
415 if (c
<= 0x7F && nb
> 1) goto invalid
;
416 if (c
<= 0x7FF && nb
> 2) goto invalid
;
417 if (c
<= 0xFFFF && nb
> 3) goto invalid
;
418 if (c
<= 0x1FFFFF && nb
> 4) goto invalid
;
419 if (c
<= 0x3FFFFFF && nb
> 5) goto invalid
;
421 /* Make sure the character is valid. */
422 if (c
> 0x7FFFFFFF || (c
>= 0xD800 && c
<= 0xDFFF))
428 generate_error (&dtp
->common
, LIBERROR_READ_VALUE
, "Invalid UTF-8 encoding");
429 return (gfc_char4_t
) '?';
434 read_utf8_char1 (st_parameter_dt
*dtp
, char *p
, size_t len
, size_t width
)
440 len
= (width
< len
) ? len
: width
;
444 /* Proceed with decoding one character at a time. */
445 for (j
= 0; j
< len
; j
++, dest
++)
447 c
= read_utf8 (dtp
, &nbytes
);
449 /* Check for a short read and if so, break out. */
453 *dest
= c
> 255 ? '?' : (uchar
) c
;
456 /* If there was a short read, pad the remaining characters. */
457 for (size_t i
= j
; i
< len
; i
++)
463 read_default_char1 (st_parameter_dt
*dtp
, char *p
, size_t len
, size_t width
)
468 s
= read_block_form (dtp
, &width
);
475 m
= (width
> len
) ? len
: width
;
479 memset (p
+ m
, ' ', len
- width
);
484 read_utf8_char4 (st_parameter_dt
*dtp
, void *p
, size_t len
, size_t width
)
489 len
= (width
< len
) ? len
: width
;
491 dest
= (gfc_char4_t
*) p
;
493 /* Proceed with decoding one character at a time. */
494 for (j
= 0; j
< len
; j
++, dest
++)
496 *dest
= read_utf8 (dtp
, &nbytes
);
498 /* Check for a short read and if so, break out. */
503 /* If there was a short read, pad the remaining characters. */
504 for (size_t i
= j
; i
< len
; i
++)
505 *dest
++ = (gfc_char4_t
) ' ';
511 read_default_char4 (st_parameter_dt
*dtp
, char *p
, size_t len
, size_t width
)
516 if (is_char4_unit(dtp
))
520 s4
= (gfc_char4_t
*) read_block_form4 (dtp
, &width
);
527 m
= (width
> len
) ? len
: width
;
529 dest
= (gfc_char4_t
*) p
;
531 for (n
= 0; n
< m
; n
++)
536 for (n
= 0; n
< len
- width
; n
++)
537 *dest
++ = (gfc_char4_t
) ' ';
544 s
= read_block_form (dtp
, &width
);
551 m
= (width
> len
) ? len
: width
;
553 dest
= (gfc_char4_t
*) p
;
555 for (n
= 0; n
< m
; n
++, dest
++, s
++)
556 *dest
= (unsigned char ) *s
;
560 for (n
= 0; n
< len
- width
; n
++, dest
++)
561 *dest
= (unsigned char) ' ';
567 /* read_a()-- Read a character record into a KIND=1 character destination,
568 processing UTF-8 encoding if necessary. */
571 read_a (st_parameter_dt
*dtp
, const fnode
*f
, char *p
, size_t length
)
575 if (f
->u
.w
== -1) /* '(A)' edit descriptor */
580 /* Read in w characters, treating comma as not a separator. */
581 dtp
->u
.p
.sf_read_comma
= 0;
583 if (dtp
->u
.p
.current_unit
->flags
.encoding
== ENCODING_UTF8
)
584 read_utf8_char1 (dtp
, p
, length
, w
);
586 read_default_char1 (dtp
, p
, length
, w
);
588 dtp
->u
.p
.sf_read_comma
=
589 dtp
->u
.p
.current_unit
->decimal_status
== DECIMAL_COMMA
? 0 : 1;
593 /* read_a_char4()-- Read a character record into a KIND=4 character destination,
594 processing UTF-8 encoding if necessary. */
597 read_a_char4 (st_parameter_dt
*dtp
, const fnode
*f
, char *p
, size_t length
)
601 if (f
->u
.w
== -1) /* '(A)' edit descriptor */
606 /* Read in w characters, treating comma as not a separator. */
607 dtp
->u
.p
.sf_read_comma
= 0;
609 if (dtp
->u
.p
.current_unit
->flags
.encoding
== ENCODING_UTF8
)
610 read_utf8_char4 (dtp
, p
, length
, w
);
612 read_default_char4 (dtp
, p
, length
, w
);
614 dtp
->u
.p
.sf_read_comma
=
615 dtp
->u
.p
.current_unit
->decimal_status
== DECIMAL_COMMA
? 0 : 1;
618 /* eat_leading_spaces()-- Given a character pointer and a width,
619 ignore the leading spaces. */
622 eat_leading_spaces (size_t *width
, char *p
)
626 if (*width
== 0 || *p
!= ' ')
638 next_char (st_parameter_dt
*dtp
, char **p
, size_t *w
)
653 if (dtp
->u
.p
.blank_status
!= BLANK_UNSPECIFIED
)
654 return ' '; /* return a blank to signal a null */
656 /* At this point, the rest of the field has to be trailing blanks */
670 /* read_decimal()-- Read a decimal integer value. The values here are
674 read_decimal (st_parameter_dt
*dtp
, const fnode
*f
, char *dest
, int length
)
676 GFC_UINTEGER_LARGEST value
, maxv
, maxv_10
;
677 GFC_INTEGER_LARGEST v
;
684 /* This is a legacy extension, and the frontend will only allow such cases
685 * through when -fdec-format-defaults is passed.
687 if (w
== (size_t) DEFAULT_WIDTH
)
688 w
= default_width_for_integer (length
);
690 p
= read_block_form (dtp
, &w
);
695 p
= eat_leading_spaces (&w
, p
);
698 set_integer (dest
, (GFC_INTEGER_LARGEST
) 0, length
);
720 maxv
= si_max (length
);
725 /* At this point we have a digit-string */
730 c
= next_char (dtp
, &p
, &w
);
736 if (dtp
->u
.p
.blank_status
== BLANK_NULL
)
739 for ( ; w
> 0; p
++, w
--)
740 if (*p
!= ' ') break;
743 if (dtp
->u
.p
.blank_status
== BLANK_ZERO
) c
= '0';
746 if (c
< '0' || c
> '9')
755 if (value
> maxv
- c
)
765 set_integer (dest
, v
, length
);
769 generate_error (&dtp
->common
, LIBERROR_READ_VALUE
,
770 "Bad value during integer read");
771 next_record (dtp
, 1);
775 generate_error (&dtp
->common
, LIBERROR_READ_OVERFLOW
,
776 "Value overflowed during integer read");
777 next_record (dtp
, 1);
782 /* read_radix()-- This function reads values for non-decimal radixes.
783 The difference here is that we treat the values here as unsigned
784 values for the purposes of overflow. If minus sign is present and
785 the top bit is set, the value will be incorrect. */
788 read_radix (st_parameter_dt
*dtp
, const fnode
*f
, char *dest
, int length
,
791 GFC_UINTEGER_LARGEST value
, maxv
, maxv_r
;
792 GFC_INTEGER_LARGEST v
;
799 p
= read_block_form (dtp
, &w
);
804 p
= eat_leading_spaces (&w
, p
);
807 set_integer (dest
, (GFC_INTEGER_LARGEST
) 0, length
);
811 /* Maximum unsigned value, assuming two's complement. */
812 maxv
= 2 * si_max (length
) + 1;
813 maxv_r
= maxv
/ radix
;
834 /* At this point we have a digit-string */
839 c
= next_char (dtp
, &p
, &w
);
844 if (dtp
->u
.p
.blank_status
== BLANK_NULL
) continue;
845 if (dtp
->u
.p
.blank_status
== BLANK_ZERO
) c
= '0';
851 if (c
< '0' || c
> '1')
856 if (c
< '0' || c
> '7')
881 c
= c
- 'a' + '9' + 1;
890 c
= c
- 'A' + '9' + 1;
904 value
= radix
* value
;
906 if (maxv
- c
< value
)
915 set_integer (dest
, v
, length
);
919 generate_error (&dtp
->common
, LIBERROR_READ_VALUE
,
920 "Bad value during integer read");
921 next_record (dtp
, 1);
925 generate_error (&dtp
->common
, LIBERROR_READ_OVERFLOW
,
926 "Value overflowed during integer read");
927 next_record (dtp
, 1);
932 /* read_f()-- Read a floating point number with F-style editing, which
933 is what all of the other floating point descriptors behave as. The
934 tricky part is that optional spaces are allowed after an E or D,
935 and the implicit decimal point if a decimal point is not present in
939 read_f (st_parameter_dt
*dtp
, const fnode
*f
, char *dest
, int length
)
945 int seen_dp
, exponent
;
950 int seen_int_digit
; /* Seen a digit before the decimal point? */
951 int seen_dec_digit
; /* Seen a digit after the decimal point? */
961 /* Read in the next block. */
962 p
= read_block_form (dtp
, &w
);
965 p
= eat_leading_spaces (&w
, (char*) p
);
969 /* In this buffer we're going to re-format the number cleanly to be parsed
970 by convert_real in the end; this assures we're using strtod from the
971 C library for parsing and thus probably get the best accuracy possible.
972 This process may add a '+0.0' in front of the number as well as change the
973 exponent because of an implicit decimal point or the like. Thus allocating
974 strlen ("+0.0e-1000") == 10 characters plus one for NUL more than the
975 original buffer had should be enough. */
977 if (buf_size
> READF_TMP
)
978 buffer
= xmalloc (buf_size
);
983 if (*p
== '-' || *p
== '+')
991 p
= eat_leading_spaces (&w
, (char*) p
);
995 /* Check for Infinity or NaN. */
996 if (unlikely ((w
>= 3 && (*p
== 'i' || *p
== 'I' || *p
== 'n' || *p
== 'N'))))
1001 /* Scan through the buffer keeping track of spaces and parenthesis. We
1002 null terminate the string as soon as we see a left paren or if we are
1003 BLANK_NULL mode. Leading spaces have already been skipped above,
1004 trailing spaces are ignored by converting to '\0'. A space
1005 between "NaN" and the optional perenthesis is not permitted. */
1008 *out
= safe_tolower (*p
);
1012 if (dtp
->u
.p
.blank_status
== BLANK_ZERO
)
1018 if (seen_paren
== 1)
1026 if (seen_paren
++ != 1)
1030 if (!safe_isalnum (*out
))
1040 if (seen_paren
!= 0 && seen_paren
!= 2)
1043 if ((strcmp (save
, "inf") == 0) || (strcmp (save
, "infinity") == 0))
1048 else if (strcmp (save
, "nan") != 0)
1051 convert_infnan (dtp
, dest
, buffer
, length
);
1052 if (buf_size
> READF_TMP
)
1057 /* Process the mantissa string. */
1063 if (dtp
->u
.p
.current_unit
->decimal_status
!= DECIMAL_COMMA
)
1067 if (!seen_int_digit
)
1074 if (dtp
->u
.p
.current_unit
->decimal_status
!= DECIMAL_POINT
)
1078 if (!seen_int_digit
)
1085 if (dtp
->u
.p
.blank_status
== BLANK_ZERO
)
1090 else if (dtp
->u
.p
.blank_status
== BLANK_NULL
)
1093 /* TODO: Should we check instead that there are only trailing
1094 blanks here, as is done below for exponents? */
1137 /* No exponent has been seen, so we use the current scale factor. */
1138 exponent
= - dtp
->u
.p
.scale_factor
;
1141 /* At this point the start of an exponent has been found. */
1143 p
= eat_leading_spaces (&w
, (char*) p
);
1144 if (*p
== '-' || *p
== '+')
1152 /* At this point a digit string is required. We calculate the value
1153 of the exponent in order to take account of the scale factor and
1154 the d parameter before explict conversion takes place. */
1158 /* Extension: allow default exponent of 0 when omitted. */
1159 if (dtp
->common
.flags
& IOPARM_DT_DEC_EXT
)
1165 if (dtp
->u
.p
.blank_status
== BLANK_UNSPECIFIED
)
1167 while (w
> 0 && safe_isdigit (*p
))
1170 exponent
+= *p
- '0';
1175 /* Only allow trailing blanks. */
1184 else /* BZ or BN status is enabled. */
1190 if (dtp
->u
.p
.blank_status
== BLANK_ZERO
)
1193 assert (dtp
->u
.p
.blank_status
== BLANK_NULL
);
1195 else if (!safe_isdigit (*p
))
1200 exponent
+= *p
- '0';
1208 exponent
*= exponent_sign
;
1211 /* Use the precision specified in the format if no decimal point has been
1214 exponent
-= f
->u
.real
.d
;
1216 /* Output a trailing '0' after decimal point if not yet found. */
1217 if (seen_dp
&& !seen_dec_digit
)
1219 /* Handle input of style "E+NN" by inserting a 0 for the
1221 else if (!seen_int_digit
&& !seen_dec_digit
)
1223 notify_std (&dtp
->common
, GFC_STD_LEGACY
,
1224 "REAL input of style 'E+NN'");
1228 /* Print out the exponent to finish the reformatted number. Maximum 4
1229 digits for the exponent. */
1238 exponent
= - exponent
;
1241 if (exponent
>= 10000)
1244 for (dig
= 3; dig
>= 0; --dig
)
1246 out
[dig
] = (char) ('0' + exponent
% 10);
1253 /* Do the actual conversion. */
1254 convert_real (dtp
, dest
, buffer
, length
);
1255 if (buf_size
> READF_TMP
)
1259 /* The value read is zero. */
1264 *((GFC_REAL_4
*) dest
) = 0.0;
1268 *((GFC_REAL_8
*) dest
) = 0.0;
1271 #ifdef HAVE_GFC_REAL_10
1273 *((GFC_REAL_10
*) dest
) = 0.0;
1277 #ifdef HAVE_GFC_REAL_16
1279 *((GFC_REAL_16
*) dest
) = 0.0;
1283 #ifdef HAVE_GFC_REAL_17
1285 *((GFC_REAL_17
*) dest
) = 0.0;
1290 internal_error (&dtp
->common
, "Unsupported real kind during IO");
1295 if (buf_size
> READF_TMP
)
1297 generate_error (&dtp
->common
, LIBERROR_READ_VALUE
,
1298 "Bad value during floating point read");
1299 next_record (dtp
, 1);
1304 /* read_x()-- Deal with the X/TR descriptor. We just read some data
1305 and never look at it. */
1308 read_x (st_parameter_dt
*dtp
, size_t n
)
1313 if ((dtp
->u
.p
.current_unit
->pad_status
== PAD_NO
|| is_internal_unit (dtp
))
1314 && dtp
->u
.p
.current_unit
->bytes_left
< (gfc_offset
) n
)
1315 n
= dtp
->u
.p
.current_unit
->bytes_left
;
1320 if (dtp
->u
.p
.current_unit
->flags
.encoding
== ENCODING_UTF8
)
1325 /* Proceed with decoding one character at a time. */
1326 for (j
= 0; j
< n
; j
++)
1328 c
= read_utf8 (dtp
, &nbytes
);
1330 /* Check for a short read and if so, break out. */
1331 if (nbytes
== 0 || c
== (gfc_char4_t
)0)
1339 if (is_internal_unit (dtp
))
1341 mem_alloc_r (dtp
->u
.p
.current_unit
->s
, &length
);
1342 if (unlikely (length
< n
))
1347 if (dtp
->u
.p
.sf_seen_eor
)
1353 q
= fbuf_getc (dtp
->u
.p
.current_unit
);
1356 else if (dtp
->u
.p
.current_unit
->flags
.cc
!= CC_NONE
1357 && (q
== '\n' || q
== '\r'))
1359 /* Unexpected end of line. Set the position. */
1360 dtp
->u
.p
.sf_seen_eor
= 1;
1362 /* If we see an EOR during non-advancing I/O, we need to skip
1363 the rest of the I/O statement. Set the corresponding flag. */
1364 if (dtp
->u
.p
.advance_status
== ADVANCE_NO
|| dtp
->u
.p
.seen_dollar
)
1365 dtp
->u
.p
.eor_condition
= 1;
1367 /* If we encounter a CR, it might be a CRLF. */
1368 if (q
== '\r') /* Probably a CRLF */
1370 /* See if there is an LF. */
1371 q2
= fbuf_getc (dtp
->u
.p
.current_unit
);
1373 dtp
->u
.p
.sf_seen_eor
= 2;
1374 else if (q2
!= EOF
) /* Oops, seek back. */
1375 fbuf_seek (dtp
->u
.p
.current_unit
, -1, SEEK_CUR
);
1383 if (((dtp
->common
.flags
& IOPARM_DT_HAS_SIZE
) != 0) ||
1384 dtp
->u
.p
.current_unit
->has_size
)
1385 dtp
->u
.p
.current_unit
->size_used
+= (GFC_IO_INT
) n
;
1386 dtp
->u
.p
.current_unit
->bytes_left
-= n
;
1387 dtp
->u
.p
.current_unit
->strm_pos
+= (gfc_offset
) n
;