1 /* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
2 Contributed by Andy Vaught
3 Namelist input contributed by Paul Thomas
5 This file is part of the GNU Fortran 95 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 2, or (at your option)
12 In addition to the permissions in the GNU General Public License, the
13 Free Software Foundation gives you unlimited permission to link the
14 compiled version of this file into combinations with other programs,
15 and to distribute those combinations without any restriction coming
16 from the use of this file. (The General Public License restrictions
17 do apply in other respects; for example, they cover modification of
18 the file, and distribution when not linked into a combine
21 Libgfortran is distributed in the hope that it will be useful,
22 but WITHOUT ANY WARRANTY; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 GNU General Public License for more details.
26 You should have received a copy of the GNU General Public License
27 along with Libgfortran; see the file COPYING. If not, write to
28 the Free Software Foundation, 51 Franklin Street, Fifth Floor,
29 Boston, MA 02110-1301, USA. */
35 #include "libgfortran.h"
39 /* List directed input. Several parsing subroutines are practically
40 reimplemented from formatted input, the reason being that there are
41 all kinds of small differences between formatted and list directed
45 /* Subroutines for reading characters from the input. Because a
46 repeat count is ambiguous with an integer, we have to read the
47 whole digit string before seeing if there is a '*' which signals
48 the repeat count. Since we can have a lot of potential leading
49 zeros, we have to be able to back up by arbitrary amount. Because
50 the input might not be seekable, we have to buffer the data
53 #define CASE_DIGITS case '0': case '1': case '2': case '3': case '4': \
54 case '5': case '6': case '7': case '8': case '9'
56 #define CASE_SEPARATORS case ' ': case ',': case '/': case '\n': case '\t': \
59 /* This macro assumes that we're operating on a variable. */
61 #define is_separator(c) (c == '/' || c == ',' || c == '\n' || c == ' ' \
62 || c == '\t' || c == '\r')
64 /* Maximum repeat count. Less than ten times the maximum signed int32. */
66 #define MAX_REPEAT 200000000
69 /* Save a character to a string buffer, enlarging it as necessary. */
72 push_char (st_parameter_dt
*dtp
, char c
)
76 if (dtp
->u
.p
.saved_string
== NULL
)
78 if (dtp
->u
.p
.scratch
== NULL
)
79 dtp
->u
.p
.scratch
= get_mem (SCRATCH_SIZE
);
80 dtp
->u
.p
.saved_string
= dtp
->u
.p
.scratch
;
81 memset (dtp
->u
.p
.saved_string
, 0, SCRATCH_SIZE
);
82 dtp
->u
.p
.saved_length
= SCRATCH_SIZE
;
83 dtp
->u
.p
.saved_used
= 0;
86 if (dtp
->u
.p
.saved_used
>= dtp
->u
.p
.saved_length
)
88 dtp
->u
.p
.saved_length
= 2 * dtp
->u
.p
.saved_length
;
89 new = get_mem (2 * dtp
->u
.p
.saved_length
);
91 memset (new, 0, 2 * dtp
->u
.p
.saved_length
);
93 memcpy (new, dtp
->u
.p
.saved_string
, dtp
->u
.p
.saved_used
);
94 if (dtp
->u
.p
.saved_string
!= dtp
->u
.p
.scratch
)
95 free_mem (dtp
->u
.p
.saved_string
);
97 dtp
->u
.p
.saved_string
= new;
100 dtp
->u
.p
.saved_string
[dtp
->u
.p
.saved_used
++] = c
;
104 /* Free the input buffer if necessary. */
107 free_saved (st_parameter_dt
*dtp
)
109 if (dtp
->u
.p
.saved_string
== NULL
)
112 if (dtp
->u
.p
.saved_string
!= dtp
->u
.p
.scratch
)
113 free_mem (dtp
->u
.p
.saved_string
);
115 dtp
->u
.p
.saved_string
= NULL
;
116 dtp
->u
.p
.saved_used
= 0;
120 /* Free the line buffer if necessary. */
123 free_line (st_parameter_dt
*dtp
)
125 if (dtp
->u
.p
.line_buffer
== NULL
)
128 free_mem (dtp
->u
.p
.line_buffer
);
129 dtp
->u
.p
.line_buffer
= NULL
;
134 next_char (st_parameter_dt
*dtp
)
140 if (dtp
->u
.p
.last_char
!= '\0')
143 c
= dtp
->u
.p
.last_char
;
144 dtp
->u
.p
.last_char
= '\0';
148 /* Read from line_buffer if enabled. */
150 if (dtp
->u
.p
.line_buffer_enabled
)
154 c
= dtp
->u
.p
.line_buffer
[dtp
->u
.p
.item_count
];
155 if (c
!= '\0' && dtp
->u
.p
.item_count
< 64)
157 dtp
->u
.p
.line_buffer
[dtp
->u
.p
.item_count
] = '\0';
158 dtp
->u
.p
.item_count
++;
162 dtp
->u
.p
.item_count
= 0;
163 dtp
->u
.p
.line_buffer_enabled
= 0;
166 /* Handle the end-of-record and end-of-file conditions for
167 internal array unit. */
168 if (is_array_io(dtp
))
171 longjmp (*dtp
->u
.p
.eof_jump
, 1);
173 /* Check for "end-of-record" condition. */
174 if (dtp
->u
.p
.current_unit
->bytes_left
== 0)
177 record
= next_array_record (dtp
, dtp
->u
.p
.current_unit
->ls
);
179 /* Check for "end-of-file" condition. */
186 record
*= dtp
->u
.p
.current_unit
->recl
;
187 if (sseek (dtp
->u
.p
.current_unit
->s
, record
) == FAILURE
)
188 longjmp (*dtp
->u
.p
.eof_jump
, 1);
190 dtp
->u
.p
.current_unit
->bytes_left
= dtp
->u
.p
.current_unit
->recl
;
195 /* Get the next character and handle end-of-record conditions. */
199 p
= salloc_r (dtp
->u
.p
.current_unit
->s
, &length
);
201 if (is_stream_io (dtp
))
202 dtp
->u
.p
.current_unit
->strm_pos
++;
204 if (is_internal_unit(dtp
))
206 if (is_array_io(dtp
))
208 /* End of record is handled in the next pass through, above. The
209 check for NULL here is cautionary. */
212 generate_error (&dtp
->common
, ERROR_INTERNAL_UNIT
, NULL
);
216 dtp
->u
.p
.current_unit
->bytes_left
--;
222 longjmp (*dtp
->u
.p
.eof_jump
, 1);
233 generate_error (&dtp
->common
, ERROR_OS
, NULL
);
237 longjmp (*dtp
->u
.p
.eof_jump
, 1);
241 dtp
->u
.p
.at_eol
= (c
== '\n' || c
== '\r');
246 /* Push a character back onto the input. */
249 unget_char (st_parameter_dt
*dtp
, char c
)
251 dtp
->u
.p
.last_char
= c
;
255 /* Skip over spaces in the input. Returns the nonspace character that
256 terminated the eating and also places it back on the input. */
259 eat_spaces (st_parameter_dt
*dtp
)
267 while (c
== ' ' || c
== '\t');
274 /* Skip over a separator. Technically, we don't always eat the whole
275 separator. This is because if we've processed the last input item,
276 then a separator is unnecessary. Plus the fact that operating
277 systems usually deliver console input on a line basis.
279 The upshot is that if we see a newline as part of reading a
280 separator, we stop reading. If there are more input items, we
281 continue reading the separator with finish_separator() which takes
282 care of the fact that we may or may not have seen a comma as part
286 eat_separator (st_parameter_dt
*dtp
)
291 dtp
->u
.p
.comma_flag
= 0;
297 dtp
->u
.p
.comma_flag
= 1;
302 dtp
->u
.p
.input_complete
= 1;
318 if (dtp
->u
.p
.namelist_mode
)
319 { /* Eat a namelist comment. */
327 /* Fall Through... */
336 /* Finish processing a separator that was interrupted by a newline.
337 If we're here, then another data item is present, so we finish what
338 we started on the previous line. */
341 finish_separator (st_parameter_dt
*dtp
)
352 if (dtp
->u
.p
.comma_flag
)
356 c
= eat_spaces (dtp
);
357 if (c
== '\n' || c
== '\r')
364 dtp
->u
.p
.input_complete
= 1;
365 if (!dtp
->u
.p
.namelist_mode
) next_record (dtp
, 0);
373 if (dtp
->u
.p
.namelist_mode
)
389 /* This function reads characters through to the end of the current line and
390 just ignores them. */
393 eat_line (st_parameter_dt
*dtp
)
396 if (!is_internal_unit (dtp
))
403 /* This function is needed to catch bad conversions so that namelist can
404 attempt to see if dtp->u.p.saved_string contains a new object name rather
408 nml_bad_return (st_parameter_dt
*dtp
, char c
)
410 if (dtp
->u
.p
.namelist_mode
)
412 dtp
->u
.p
.nml_read_error
= 1;
419 /* Convert an unsigned string to an integer. The length value is -1
420 if we are working on a repeat count. Returns nonzero if we have a
421 range problem. As a side effect, frees the dtp->u.p.saved_string. */
424 convert_integer (st_parameter_dt
*dtp
, int length
, int negative
)
426 char c
, *buffer
, message
[100];
428 GFC_INTEGER_LARGEST v
, max
, max10
;
430 buffer
= dtp
->u
.p
.saved_string
;
433 max
= (length
== -1) ? MAX_REPEAT
: max_value (length
, 1);
458 set_integer (dtp
->u
.p
.value
, v
, length
);
462 dtp
->u
.p
.repeat_count
= v
;
464 if (dtp
->u
.p
.repeat_count
== 0)
466 st_sprintf (message
, "Zero repeat count in item %d of list input",
467 dtp
->u
.p
.item_count
);
469 generate_error (&dtp
->common
, ERROR_READ_VALUE
, message
);
479 st_sprintf (message
, "Repeat count overflow in item %d of list input",
480 dtp
->u
.p
.item_count
);
482 st_sprintf (message
, "Integer overflow while reading item %d",
483 dtp
->u
.p
.item_count
);
486 generate_error (&dtp
->common
, ERROR_READ_VALUE
, message
);
492 /* Parse a repeat count for logical and complex values which cannot
493 begin with a digit. Returns nonzero if we are done, zero if we
494 should continue on. */
497 parse_repeat (st_parameter_dt
*dtp
)
499 char c
, message
[100];
525 repeat
= 10 * repeat
+ c
- '0';
527 if (repeat
> MAX_REPEAT
)
530 "Repeat count overflow in item %d of list input",
531 dtp
->u
.p
.item_count
);
533 generate_error (&dtp
->common
, ERROR_READ_VALUE
, message
);
543 "Zero repeat count in item %d of list input",
544 dtp
->u
.p
.item_count
);
546 generate_error (&dtp
->common
, ERROR_READ_VALUE
, message
);
558 dtp
->u
.p
.repeat_count
= repeat
;
565 st_sprintf (message
, "Bad repeat count in item %d of list input",
566 dtp
->u
.p
.item_count
);
567 generate_error (&dtp
->common
, ERROR_READ_VALUE
, message
);
572 /* To read a logical we have to look ahead in the input stream to make sure
573 there is not an equal sign indicating a variable name. To do this we use
574 line_buffer to point to a temporary buffer, pushing characters there for
575 possible later reading. */
578 l_push_char (st_parameter_dt
*dtp
, char c
)
580 if (dtp
->u
.p
.line_buffer
== NULL
)
582 dtp
->u
.p
.line_buffer
= get_mem (SCRATCH_SIZE
);
583 memset (dtp
->u
.p
.line_buffer
, 0, SCRATCH_SIZE
);
586 dtp
->u
.p
.line_buffer
[dtp
->u
.p
.item_count
++] = c
;
590 /* Read a logical character on the input. */
593 read_logical (st_parameter_dt
*dtp
, int length
)
595 char c
, message
[100];
598 if (parse_repeat (dtp
))
601 c
= tolower (next_char (dtp
));
602 l_push_char (dtp
, c
);
608 l_push_char (dtp
, c
);
610 if (!is_separator(c
))
618 l_push_char (dtp
, c
);
620 if (!is_separator(c
))
626 c
= tolower (next_char (dtp
));
644 return; /* Null value. */
650 dtp
->u
.p
.saved_type
= BT_LOGICAL
;
651 dtp
->u
.p
.saved_length
= length
;
653 /* Eat trailing garbage. */
658 while (!is_separator (c
));
662 dtp
->u
.p
.item_count
= 0;
663 dtp
->u
.p
.line_buffer_enabled
= 0;
664 set_integer ((int *) dtp
->u
.p
.value
, v
, length
);
671 for(i
= 0; i
< 63; i
++)
676 /* All done if this is not a namelist read. */
677 if (!dtp
->u
.p
.namelist_mode
)
690 l_push_char (dtp
, c
);
693 dtp
->u
.p
.nml_read_error
= 1;
694 dtp
->u
.p
.line_buffer_enabled
= 1;
695 dtp
->u
.p
.item_count
= 0;
705 if (nml_bad_return (dtp
, c
))
710 st_sprintf (message
, "Bad logical value while reading item %d",
711 dtp
->u
.p
.item_count
);
712 generate_error (&dtp
->common
, ERROR_READ_VALUE
, message
);
717 dtp
->u
.p
.item_count
= 0;
718 dtp
->u
.p
.line_buffer_enabled
= 0;
719 dtp
->u
.p
.saved_type
= BT_LOGICAL
;
720 dtp
->u
.p
.saved_length
= length
;
721 set_integer ((int *) dtp
->u
.p
.value
, v
, length
);
727 /* Reading integers is tricky because we can actually be reading a
728 repeat count. We have to store the characters in a buffer because
729 we could be reading an integer that is larger than the default int
730 used for repeat counts. */
733 read_integer (st_parameter_dt
*dtp
, int length
)
735 char c
, message
[100];
745 /* Fall through... */
751 CASE_SEPARATORS
: /* Single null. */
764 /* Take care of what may be a repeat count. */
776 push_char (dtp
, '\0');
779 CASE_SEPARATORS
: /* Not a repeat count. */
788 if (convert_integer (dtp
, -1, 0))
791 /* Get the real integer. */
806 /* Fall through... */
837 if (nml_bad_return (dtp
, c
))
842 st_sprintf (message
, "Bad integer for item %d in list input",
843 dtp
->u
.p
.item_count
);
844 generate_error (&dtp
->common
, ERROR_READ_VALUE
, message
);
852 push_char (dtp
, '\0');
853 if (convert_integer (dtp
, length
, negative
))
860 dtp
->u
.p
.saved_type
= BT_INTEGER
;
864 /* Read a character variable. */
867 read_character (st_parameter_dt
*dtp
, int length
__attribute__ ((unused
)))
869 char c
, quote
, message
[100];
871 quote
= ' '; /* Space means no quote character. */
881 unget_char (dtp
, c
); /* NULL value. */
891 if (dtp
->u
.p
.namelist_mode
)
900 /* Deal with a possible repeat count. */
913 goto done
; /* String was only digits! */
916 push_char (dtp
, '\0');
921 goto get_string
; /* Not a repeat count after all. */
926 if (convert_integer (dtp
, -1, 0))
929 /* Now get the real string. */
935 unget_char (dtp
, c
); /* Repeated NULL values. */
963 /* See if we have a doubled quote character or the end of
969 push_char (dtp
, quote
);
983 if (c
!= '\n' && c
!= '\r')
993 /* At this point, we have to have a separator, or else the string is
997 if (is_separator (c
))
1000 eat_separator (dtp
);
1001 dtp
->u
.p
.saved_type
= BT_CHARACTER
;
1006 st_sprintf (message
, "Invalid string input in item %d",
1007 dtp
->u
.p
.item_count
);
1008 generate_error (&dtp
->common
, ERROR_READ_VALUE
, message
);
1013 /* Parse a component of a complex constant or a real number that we
1014 are sure is already there. This is a straight real number parser. */
1017 parse_real (st_parameter_dt
*dtp
, void *buffer
, int length
)
1019 char c
, message
[100];
1022 c
= next_char (dtp
);
1023 if (c
== '-' || c
== '+')
1026 c
= next_char (dtp
);
1029 if (!isdigit (c
) && c
!= '.')
1034 seen_dp
= (c
== '.') ? 1 : 0;
1038 c
= next_char (dtp
);
1057 push_char (dtp
, 'e');
1062 push_char (dtp
, 'e');
1064 c
= next_char (dtp
);
1068 unget_char (dtp
, c
);
1077 c
= next_char (dtp
);
1078 if (c
!= '-' && c
!= '+')
1079 push_char (dtp
, '+');
1083 c
= next_char (dtp
);
1093 c
= next_char (dtp
);
1101 unget_char (dtp
, c
);
1110 unget_char (dtp
, c
);
1111 push_char (dtp
, '\0');
1113 m
= convert_real (dtp
, buffer
, dtp
->u
.p
.saved_string
, length
);
1120 if (nml_bad_return (dtp
, c
))
1125 st_sprintf (message
, "Bad floating point number for item %d",
1126 dtp
->u
.p
.item_count
);
1127 generate_error (&dtp
->common
, ERROR_READ_VALUE
, message
);
1133 /* Reading a complex number is straightforward because we can tell
1134 what it is right away. */
1137 read_complex (st_parameter_dt
*dtp
, int kind
, size_t size
)
1142 if (parse_repeat (dtp
))
1145 c
= next_char (dtp
);
1152 unget_char (dtp
, c
);
1153 eat_separator (dtp
);
1161 if (parse_real (dtp
, dtp
->u
.p
.value
, kind
))
1166 c
= next_char (dtp
);
1167 if (c
== '\n' || c
== '\r')
1170 unget_char (dtp
, c
);
1172 if (next_char (dtp
) != ',')
1177 c
= next_char (dtp
);
1178 if (c
== '\n' || c
== '\r')
1181 unget_char (dtp
, c
);
1183 if (parse_real (dtp
, dtp
->u
.p
.value
+ size
/ 2, kind
))
1187 if (next_char (dtp
) != ')')
1190 c
= next_char (dtp
);
1191 if (!is_separator (c
))
1194 unget_char (dtp
, c
);
1195 eat_separator (dtp
);
1198 dtp
->u
.p
.saved_type
= BT_COMPLEX
;
1203 if (nml_bad_return (dtp
, c
))
1208 st_sprintf (message
, "Bad complex value in item %d of list input",
1209 dtp
->u
.p
.item_count
);
1210 generate_error (&dtp
->common
, ERROR_READ_VALUE
, message
);
1214 /* Parse a real number with a possible repeat count. */
1217 read_real (st_parameter_dt
*dtp
, int length
)
1219 char c
, message
[100];
1224 c
= next_char (dtp
);
1241 unget_char (dtp
, c
); /* Single null. */
1242 eat_separator (dtp
);
1249 /* Get the digit string that might be a repeat count. */
1253 c
= next_char (dtp
);
1276 push_char (dtp
, 'e');
1278 c
= next_char (dtp
);
1282 push_char (dtp
, '\0');
1286 if (c
!= '\n' && c
!= ',' && c
!= '\r')
1287 unget_char (dtp
, c
);
1296 if (convert_integer (dtp
, -1, 0))
1299 /* Now get the number itself. */
1301 c
= next_char (dtp
);
1302 if (is_separator (c
))
1303 { /* Repeated null value. */
1304 unget_char (dtp
, c
);
1305 eat_separator (dtp
);
1309 if (c
!= '-' && c
!= '+')
1310 push_char (dtp
, '+');
1315 c
= next_char (dtp
);
1318 if (!isdigit (c
) && c
!= '.')
1334 c
= next_char (dtp
);
1360 push_char (dtp
, 'e');
1362 c
= next_char (dtp
);
1371 push_char (dtp
, 'e');
1373 c
= next_char (dtp
);
1374 if (c
!= '+' && c
!= '-')
1375 push_char (dtp
, '+');
1379 c
= next_char (dtp
);
1389 c
= next_char (dtp
);
1406 unget_char (dtp
, c
);
1407 eat_separator (dtp
);
1408 push_char (dtp
, '\0');
1409 if (convert_real (dtp
, dtp
->u
.p
.value
, dtp
->u
.p
.saved_string
, length
))
1413 dtp
->u
.p
.saved_type
= BT_REAL
;
1418 if (nml_bad_return (dtp
, c
))
1423 st_sprintf (message
, "Bad real number in item %d of list input",
1424 dtp
->u
.p
.item_count
);
1425 generate_error (&dtp
->common
, ERROR_READ_VALUE
, message
);
1429 /* Check the current type against the saved type to make sure they are
1430 compatible. Returns nonzero if incompatible. */
1433 check_type (st_parameter_dt
*dtp
, bt type
, int len
)
1437 if (dtp
->u
.p
.saved_type
!= BT_NULL
&& dtp
->u
.p
.saved_type
!= type
)
1439 st_sprintf (message
, "Read type %s where %s was expected for item %d",
1440 type_name (dtp
->u
.p
.saved_type
), type_name (type
),
1441 dtp
->u
.p
.item_count
);
1443 generate_error (&dtp
->common
, ERROR_READ_VALUE
, message
);
1447 if (dtp
->u
.p
.saved_type
== BT_NULL
|| dtp
->u
.p
.saved_type
== BT_CHARACTER
)
1450 if (dtp
->u
.p
.saved_length
!= len
)
1452 st_sprintf (message
,
1453 "Read kind %d %s where kind %d is required for item %d",
1454 dtp
->u
.p
.saved_length
, type_name (dtp
->u
.p
.saved_type
), len
,
1455 dtp
->u
.p
.item_count
);
1456 generate_error (&dtp
->common
, ERROR_READ_VALUE
, message
);
1464 /* Top level data transfer subroutine for list reads. Because we have
1465 to deal with repeat counts, the data item is always saved after
1466 reading, usually in the dtp->u.p.value[] array. If a repeat count is
1467 greater than one, we copy the data item multiple times. */
1470 list_formatted_read_scalar (st_parameter_dt
*dtp
, bt type
, void *p
, int kind
,
1477 dtp
->u
.p
.namelist_mode
= 0;
1479 dtp
->u
.p
.eof_jump
= &eof_jump
;
1480 if (setjmp (eof_jump
))
1482 generate_error (&dtp
->common
, ERROR_END
, NULL
);
1486 if (dtp
->u
.p
.first_item
)
1488 dtp
->u
.p
.first_item
= 0;
1489 dtp
->u
.p
.input_complete
= 0;
1490 dtp
->u
.p
.repeat_count
= 1;
1491 dtp
->u
.p
.at_eol
= 0;
1493 c
= eat_spaces (dtp
);
1494 if (is_separator (c
))
1495 { /* Found a null value. */
1496 eat_separator (dtp
);
1497 dtp
->u
.p
.repeat_count
= 0;
1499 /* eat_separator sets this flag if the separator was a comma */
1500 if (dtp
->u
.p
.comma_flag
)
1503 /* eat_separator sets this flag if the separator was a \n or \r */
1504 if (dtp
->u
.p
.at_eol
)
1505 finish_separator (dtp
);
1513 if (dtp
->u
.p
.input_complete
)
1516 if (dtp
->u
.p
.repeat_count
> 0)
1518 if (check_type (dtp
, type
, kind
))
1523 if (dtp
->u
.p
.at_eol
)
1524 finish_separator (dtp
);
1528 /* trailing spaces prior to end of line */
1529 if (dtp
->u
.p
.at_eol
)
1530 finish_separator (dtp
);
1533 dtp
->u
.p
.saved_type
= BT_NULL
;
1534 dtp
->u
.p
.repeat_count
= 1;
1540 read_integer (dtp
, kind
);
1543 read_logical (dtp
, kind
);
1546 read_character (dtp
, kind
);
1549 read_real (dtp
, kind
);
1552 read_complex (dtp
, kind
, size
);
1555 internal_error (&dtp
->common
, "Bad type for list read");
1558 if (dtp
->u
.p
.saved_type
!= BT_CHARACTER
&& dtp
->u
.p
.saved_type
!= BT_NULL
)
1559 dtp
->u
.p
.saved_length
= size
;
1561 if ((dtp
->common
.flags
& IOPARM_LIBRETURN_MASK
) != IOPARM_LIBRETURN_OK
)
1565 switch (dtp
->u
.p
.saved_type
)
1571 memcpy (p
, dtp
->u
.p
.value
, size
);
1575 if (dtp
->u
.p
.saved_string
)
1577 m
= ((int) size
< dtp
->u
.p
.saved_used
)
1578 ? (int) size
: dtp
->u
.p
.saved_used
;
1579 memcpy (p
, dtp
->u
.p
.saved_string
, m
);
1582 /* Just delimiters encountered, nothing to copy but SPACE. */
1586 memset (((char *) p
) + m
, ' ', size
- m
);
1593 if (--dtp
->u
.p
.repeat_count
<= 0)
1597 dtp
->u
.p
.eof_jump
= NULL
;
1602 list_formatted_read (st_parameter_dt
*dtp
, bt type
, void *p
, int kind
,
1603 size_t size
, size_t nelems
)
1610 /* Big loop over all the elements. */
1611 for (elem
= 0; elem
< nelems
; elem
++)
1613 dtp
->u
.p
.item_count
++;
1614 list_formatted_read_scalar (dtp
, type
, tmp
+ size
*elem
, kind
, size
);
1619 /* Finish a list read. */
1622 finish_list_read (st_parameter_dt
*dtp
)
1628 if (dtp
->u
.p
.at_eol
)
1630 dtp
->u
.p
.at_eol
= 0;
1636 c
= next_char (dtp
);
1643 void namelist_read (st_parameter_dt *dtp)
1645 static void nml_match_name (char *name, int len)
1646 static int nml_query (st_parameter_dt *dtp)
1647 static int nml_get_obj_data (st_parameter_dt *dtp,
1648 namelist_info **prev_nl, char *)
1650 static void nml_untouch_nodes (st_parameter_dt *dtp)
1651 static namelist_info * find_nml_node (st_parameter_dt *dtp,
1653 static int nml_parse_qualifier(descriptor_dimension * ad,
1654 array_loop_spec * ls, int rank, char *)
1655 static void nml_touch_nodes (namelist_info * nl)
1656 static int nml_read_obj (namelist_info *nl, index_type offset,
1657 namelist_info **prev_nl, char *,
1658 index_type clow, index_type chigh)
1662 /* Inputs a rank-dimensional qualifier, which can contain
1663 singlets, doublets, triplets or ':' with the standard meanings. */
1666 nml_parse_qualifier (st_parameter_dt
*dtp
, descriptor_dimension
*ad
,
1667 array_loop_spec
*ls
, int rank
, char *parse_err_msg
)
1673 int is_array_section
;
1676 is_array_section
= 0;
1677 dtp
->u
.p
.expanded_read
= 0;
1679 /* The next character in the stream should be the '('. */
1681 c
= next_char (dtp
);
1683 /* Process the qualifier, by dimension and triplet. */
1685 for (dim
=0; dim
< rank
; dim
++ )
1687 for (indx
=0; indx
<3; indx
++)
1693 /* Process a potential sign. */
1694 c
= next_char (dtp
);
1705 unget_char (dtp
, c
);
1709 /* Process characters up to the next ':' , ',' or ')'. */
1712 c
= next_char (dtp
);
1717 is_array_section
= 1;
1721 if ((c
==',' && dim
== rank
-1)
1722 || (c
==')' && dim
< rank
-1))
1724 st_sprintf (parse_err_msg
,
1725 "Bad number of index fields");
1734 case ' ': case '\t':
1736 c
= next_char (dtp
);
1740 st_sprintf (parse_err_msg
, "Bad character in index");
1744 if ((c
== ',' || c
== ')') && indx
== 0
1745 && dtp
->u
.p
.saved_string
== 0)
1747 st_sprintf (parse_err_msg
, "Null index field");
1751 if ((c
== ':' && indx
== 1 && dtp
->u
.p
.saved_string
== 0)
1752 || (indx
== 2 && dtp
->u
.p
.saved_string
== 0))
1754 st_sprintf(parse_err_msg
, "Bad index triplet");
1758 /* If '( : ? )' or '( ? : )' break and flag read failure. */
1760 if ((c
== ':' && indx
== 0 && dtp
->u
.p
.saved_string
== 0)
1761 || (indx
==1 && dtp
->u
.p
.saved_string
== 0))
1767 /* Now read the index. */
1768 if (convert_integer (dtp
, sizeof(ssize_t
), neg
))
1770 st_sprintf (parse_err_msg
, "Bad integer in index");
1776 /* Feed the index values to the triplet arrays. */
1780 memcpy (&ls
[dim
].start
, dtp
->u
.p
.value
, sizeof(ssize_t
));
1782 memcpy (&ls
[dim
].end
, dtp
->u
.p
.value
, sizeof(ssize_t
));
1784 memcpy (&ls
[dim
].step
, dtp
->u
.p
.value
, sizeof(ssize_t
));
1787 /* Singlet or doublet indices. */
1788 if (c
==',' || c
==')')
1792 memcpy (&ls
[dim
].start
, dtp
->u
.p
.value
, sizeof(ssize_t
));
1794 /* If -std=f95/2003 or an array section is specified,
1795 do not allow excess data to be processed. */
1796 if (is_array_section
== 1
1797 || compile_options
.allow_std
< GFC_STD_GNU
)
1798 ls
[dim
].end
= ls
[dim
].start
;
1800 dtp
->u
.p
.expanded_read
= 1;
1806 /* Check the values of the triplet indices. */
1807 if ((ls
[dim
].start
> (ssize_t
)ad
[dim
].ubound
)
1808 || (ls
[dim
].start
< (ssize_t
)ad
[dim
].lbound
)
1809 || (ls
[dim
].end
> (ssize_t
)ad
[dim
].ubound
)
1810 || (ls
[dim
].end
< (ssize_t
)ad
[dim
].lbound
))
1812 st_sprintf (parse_err_msg
, "Index %d out of range", dim
+ 1);
1815 if (((ls
[dim
].end
- ls
[dim
].start
) * ls
[dim
].step
< 0)
1816 || (ls
[dim
].step
== 0))
1818 st_sprintf (parse_err_msg
, "Bad range in index %d", dim
+ 1);
1822 /* Initialise the loop index counter. */
1823 ls
[dim
].idx
= ls
[dim
].start
;
1833 static namelist_info
*
1834 find_nml_node (st_parameter_dt
*dtp
, char * var_name
)
1836 namelist_info
* t
= dtp
->u
.p
.ionml
;
1839 if (strcmp (var_name
, t
->var_name
) == 0)
1849 /* Visits all the components of a derived type that have
1850 not explicitly been identified in the namelist input.
1851 touched is set and the loop specification initialised
1852 to default values */
1855 nml_touch_nodes (namelist_info
* nl
)
1857 index_type len
= strlen (nl
->var_name
) + 1;
1859 char * ext_name
= (char*)get_mem (len
+ 1);
1860 strcpy (ext_name
, nl
->var_name
);
1861 strcat (ext_name
, "%");
1862 for (nl
= nl
->next
; nl
; nl
= nl
->next
)
1864 if (strncmp (nl
->var_name
, ext_name
, len
) == 0)
1867 for (dim
=0; dim
< nl
->var_rank
; dim
++)
1869 nl
->ls
[dim
].step
= 1;
1870 nl
->ls
[dim
].end
= nl
->dim
[dim
].ubound
;
1871 nl
->ls
[dim
].start
= nl
->dim
[dim
].lbound
;
1872 nl
->ls
[dim
].idx
= nl
->ls
[dim
].start
;
1878 free_mem (ext_name
);
1882 /* Resets touched for the entire list of nml_nodes, ready for a
1886 nml_untouch_nodes (st_parameter_dt
*dtp
)
1889 for (t
= dtp
->u
.p
.ionml
; t
; t
= t
->next
)
1894 /* Attempts to input name to namelist name. Returns
1895 dtp->u.p.nml_read_error = 1 on no match. */
1898 nml_match_name (st_parameter_dt
*dtp
, const char *name
, index_type len
)
1902 dtp
->u
.p
.nml_read_error
= 0;
1903 for (i
= 0; i
< len
; i
++)
1905 c
= next_char (dtp
);
1906 if (tolower (c
) != tolower (name
[i
]))
1908 dtp
->u
.p
.nml_read_error
= 1;
1914 /* If the namelist read is from stdin, output the current state of the
1915 namelist to stdout. This is used to implement the non-standard query
1916 features, ? and =?. If c == '=' the full namelist is printed. Otherwise
1917 the names alone are printed. */
1920 nml_query (st_parameter_dt
*dtp
, char c
)
1922 gfc_unit
* temp_unit
;
1927 if (dtp
->u
.p
.current_unit
->unit_number
!= options
.stdin_unit
)
1930 /* Store the current unit and transfer to stdout. */
1932 temp_unit
= dtp
->u
.p
.current_unit
;
1933 dtp
->u
.p
.current_unit
= find_unit (options
.stdout_unit
);
1935 if (dtp
->u
.p
.current_unit
)
1937 dtp
->u
.p
.mode
= WRITING
;
1938 next_record (dtp
, 0);
1940 /* Write the namelist in its entirety. */
1943 namelist_write (dtp
);
1945 /* Or write the list of names. */
1950 /* "&namelist_name\n" */
1952 len
= dtp
->namelist_name_len
;
1954 p
= write_block (dtp
, len
+ 3);
1956 p
= write_block (dtp
, len
+ 2);
1961 memcpy ((char*)(p
+ 1), dtp
->namelist_name
, len
);
1963 memcpy ((char*)(p
+ len
+ 1), "\r\n", 2);
1965 memcpy ((char*)(p
+ len
+ 1), "\n", 1);
1967 for (nl
= dtp
->u
.p
.ionml
; nl
; nl
= nl
->next
)
1972 len
= strlen (nl
->var_name
);
1974 p
= write_block (dtp
, len
+ 3);
1976 p
= write_block (dtp
, len
+ 2);
1981 memcpy ((char*)(p
+ 1), nl
->var_name
, len
);
1983 memcpy ((char*)(p
+ len
+ 1), "\r\n", 2);
1985 memcpy ((char*)(p
+ len
+ 1), "\n", 1);
1992 p
= write_block (dtp
, 6);
1994 p
= write_block (dtp
, 5);
1999 memcpy (p
, "&end\r\n", 6);
2001 memcpy (p
, "&end\n", 5);
2005 /* Flush the stream to force immediate output. */
2007 flush (dtp
->u
.p
.current_unit
->s
);
2008 unlock_unit (dtp
->u
.p
.current_unit
);
2013 /* Restore the current unit. */
2015 dtp
->u
.p
.current_unit
= temp_unit
;
2016 dtp
->u
.p
.mode
= READING
;
2020 /* Reads and stores the input for the namelist object nl. For an array,
2021 the function loops over the ranges defined by the loop specification.
2022 This default to all the data or to the specification from a qualifier.
2023 nml_read_obj recursively calls itself to read derived types. It visits
2024 all its own components but only reads data for those that were touched
2025 when the name was parsed. If a read error is encountered, an attempt is
2026 made to return to read a new object name because the standard allows too
2027 little data to be available. On the other hand, too much data is an
2031 nml_read_obj (st_parameter_dt
*dtp
, namelist_info
* nl
, index_type offset
,
2032 namelist_info
**pprev_nl
, char *nml_err_msg
,
2033 index_type clow
, index_type chigh
)
2036 namelist_info
* cmp
;
2043 index_type obj_name_len
;
2046 /* This object not touched in name parsing. */
2051 dtp
->u
.p
.repeat_count
= 0;
2058 case GFC_DTYPE_INTEGER
:
2059 case GFC_DTYPE_LOGICAL
:
2063 case GFC_DTYPE_REAL
:
2064 dlen
= size_from_real_kind (len
);
2067 case GFC_DTYPE_COMPLEX
:
2068 dlen
= size_from_complex_kind (len
);
2071 case GFC_DTYPE_CHARACTER
:
2072 dlen
= chigh
? (chigh
- clow
+ 1) : nl
->string_length
;
2082 /* Update the pointer to the data, using the current index vector */
2084 pdata
= (void*)(nl
->mem_pos
+ offset
);
2085 for (dim
= 0; dim
< nl
->var_rank
; dim
++)
2086 pdata
= (void*)(pdata
+ (nl
->ls
[dim
].idx
- nl
->dim
[dim
].lbound
) *
2087 nl
->dim
[dim
].stride
* nl
->size
);
2089 /* Reset the error flag and try to read next value, if
2090 dtp->u.p.repeat_count=0 */
2092 dtp
->u
.p
.nml_read_error
= 0;
2094 if (--dtp
->u
.p
.repeat_count
<= 0)
2096 if (dtp
->u
.p
.input_complete
)
2098 if (dtp
->u
.p
.at_eol
)
2099 finish_separator (dtp
);
2100 if (dtp
->u
.p
.input_complete
)
2103 /* GFC_TYPE_UNKNOWN through for nulls and is detected
2104 after the switch block. */
2106 dtp
->u
.p
.saved_type
= GFC_DTYPE_UNKNOWN
;
2111 case GFC_DTYPE_INTEGER
:
2112 read_integer (dtp
, len
);
2115 case GFC_DTYPE_LOGICAL
:
2116 read_logical (dtp
, len
);
2119 case GFC_DTYPE_CHARACTER
:
2120 read_character (dtp
, len
);
2123 case GFC_DTYPE_REAL
:
2124 read_real (dtp
, len
);
2127 case GFC_DTYPE_COMPLEX
:
2128 read_complex (dtp
, len
, dlen
);
2131 case GFC_DTYPE_DERIVED
:
2132 obj_name_len
= strlen (nl
->var_name
) + 1;
2133 obj_name
= get_mem (obj_name_len
+1);
2134 strcpy (obj_name
, nl
->var_name
);
2135 strcat (obj_name
, "%");
2137 /* If reading a derived type, disable the expanded read warning
2138 since a single object can have multiple reads. */
2139 dtp
->u
.p
.expanded_read
= 0;
2141 /* Now loop over the components. Update the component pointer
2142 with the return value from nml_write_obj. This loop jumps
2143 past nested derived types by testing if the potential
2144 component name contains '%'. */
2146 for (cmp
= nl
->next
;
2148 !strncmp (cmp
->var_name
, obj_name
, obj_name_len
) &&
2149 !strchr (cmp
->var_name
+ obj_name_len
, '%');
2153 if (nml_read_obj (dtp
, cmp
, (index_type
)(pdata
- nl
->mem_pos
),
2154 pprev_nl
, nml_err_msg
, clow
, chigh
)
2157 free_mem (obj_name
);
2161 if (dtp
->u
.p
.input_complete
)
2163 free_mem (obj_name
);
2168 free_mem (obj_name
);
2172 st_sprintf (nml_err_msg
, "Bad type for namelist object %s",
2174 internal_error (&dtp
->common
, nml_err_msg
);
2179 /* The standard permits array data to stop short of the number of
2180 elements specified in the loop specification. In this case, we
2181 should be here with dtp->u.p.nml_read_error != 0. Control returns to
2182 nml_get_obj_data and an attempt is made to read object name. */
2185 if (dtp
->u
.p
.nml_read_error
)
2187 dtp
->u
.p
.expanded_read
= 0;
2191 if (dtp
->u
.p
.saved_type
== GFC_DTYPE_UNKNOWN
)
2193 dtp
->u
.p
.expanded_read
= 0;
2197 /* Note the switch from GFC_DTYPE_type to BT_type at this point.
2198 This comes about because the read functions return BT_types. */
2200 switch (dtp
->u
.p
.saved_type
)
2207 memcpy (pdata
, dtp
->u
.p
.value
, dlen
);
2211 m
= (dlen
< dtp
->u
.p
.saved_used
) ? dlen
: dtp
->u
.p
.saved_used
;
2212 pdata
= (void*)( pdata
+ clow
- 1 );
2213 memcpy (pdata
, dtp
->u
.p
.saved_string
, m
);
2215 memset ((void*)( pdata
+ m
), ' ', dlen
- m
);
2222 /* Warn if a non-standard expanded read occurs. A single read of a
2223 single object is acceptable. If a second read occurs, issue a warning
2224 and set the flag to zero to prevent further warnings. */
2225 if (dtp
->u
.p
.expanded_read
== 2)
2227 notify_std (&dtp
->common
, GFC_STD_GNU
, "Non-standard expanded namelist read.");
2228 dtp
->u
.p
.expanded_read
= 0;
2231 /* If the expanded read warning flag is set, increment it,
2232 indicating that a single read has occurred. */
2233 if (dtp
->u
.p
.expanded_read
>= 1)
2234 dtp
->u
.p
.expanded_read
++;
2236 /* Break out of loop if scalar. */
2240 /* Now increment the index vector. */
2245 for (dim
= 0; dim
< nl
->var_rank
; dim
++)
2247 nl
->ls
[dim
].idx
+= nml_carry
* nl
->ls
[dim
].step
;
2249 if (((nl
->ls
[dim
].step
> 0) && (nl
->ls
[dim
].idx
> nl
->ls
[dim
].end
))
2251 ((nl
->ls
[dim
].step
< 0) && (nl
->ls
[dim
].idx
< nl
->ls
[dim
].end
)))
2253 nl
->ls
[dim
].idx
= nl
->ls
[dim
].start
;
2257 } while (!nml_carry
);
2259 if (dtp
->u
.p
.repeat_count
> 1)
2261 st_sprintf (nml_err_msg
, "Repeat count too large for namelist object %s" ,
2272 /* Parses the object name, including array and substring qualifiers. It
2273 iterates over derived type components, touching those components and
2274 setting their loop specifications, if there is a qualifier. If the
2275 object is itself a derived type, its components and subcomponents are
2276 touched. nml_read_obj is called at the end and this reads the data in
2277 the manner specified by the object name. */
2280 nml_get_obj_data (st_parameter_dt
*dtp
, namelist_info
**pprev_nl
,
2285 namelist_info
* first_nl
= NULL
;
2286 namelist_info
* root_nl
= NULL
;
2289 char parse_err_msg
[30];
2290 index_type clow
, chigh
;
2292 /* Look for end of input or object name. If '?' or '=?' are encountered
2293 in stdin, print the node names or the namelist to stdout. */
2295 eat_separator (dtp
);
2296 if (dtp
->u
.p
.input_complete
)
2299 if (dtp
->u
.p
.at_eol
)
2300 finish_separator (dtp
);
2301 if (dtp
->u
.p
.input_complete
)
2304 c
= next_char (dtp
);
2308 c
= next_char (dtp
);
2311 st_sprintf (nml_err_msg
, "namelist read: misplaced = sign");
2314 nml_query (dtp
, '=');
2318 nml_query (dtp
, '?');
2323 nml_match_name (dtp
, "end", 3);
2324 if (dtp
->u
.p
.nml_read_error
)
2326 st_sprintf (nml_err_msg
, "namelist not terminated with / or &end");
2330 dtp
->u
.p
.input_complete
= 1;
2337 /* Untouch all nodes of the namelist and reset the flag that is set for
2338 derived type components. */
2340 nml_untouch_nodes (dtp
);
2343 /* Get the object name - should '!' and '\n' be permitted separators? */
2351 push_char (dtp
, tolower(c
));
2352 c
= next_char (dtp
);
2353 } while (!( c
=='=' || c
==' ' || c
=='\t' || c
=='(' || c
=='%' ));
2355 unget_char (dtp
, c
);
2357 /* Check that the name is in the namelist and get pointer to object.
2358 Three error conditions exist: (i) An attempt is being made to
2359 identify a non-existent object, following a failed data read or
2360 (ii) The object name does not exist or (iii) Too many data items
2361 are present for an object. (iii) gives the same error message
2364 push_char (dtp
, '\0');
2368 size_t var_len
= strlen (root_nl
->var_name
);
2370 = dtp
->u
.p
.saved_string
? strlen (dtp
->u
.p
.saved_string
) : 0;
2371 char ext_name
[var_len
+ saved_len
+ 1];
2373 memcpy (ext_name
, root_nl
->var_name
, var_len
);
2374 if (dtp
->u
.p
.saved_string
)
2375 memcpy (ext_name
+ var_len
, dtp
->u
.p
.saved_string
, saved_len
);
2376 ext_name
[var_len
+ saved_len
] = '\0';
2377 nl
= find_nml_node (dtp
, ext_name
);
2380 nl
= find_nml_node (dtp
, dtp
->u
.p
.saved_string
);
2384 if (dtp
->u
.p
.nml_read_error
&& *pprev_nl
)
2385 st_sprintf (nml_err_msg
, "Bad data for namelist object %s",
2386 (*pprev_nl
)->var_name
);
2389 st_sprintf (nml_err_msg
, "Cannot match namelist object name %s",
2390 dtp
->u
.p
.saved_string
);
2395 /* Get the length, data length, base pointer and rank of the variable.
2396 Set the default loop specification first. */
2398 for (dim
=0; dim
< nl
->var_rank
; dim
++)
2400 nl
->ls
[dim
].step
= 1;
2401 nl
->ls
[dim
].end
= nl
->dim
[dim
].ubound
;
2402 nl
->ls
[dim
].start
= nl
->dim
[dim
].lbound
;
2403 nl
->ls
[dim
].idx
= nl
->ls
[dim
].start
;
2406 /* Check to see if there is a qualifier: if so, parse it.*/
2408 if (c
== '(' && nl
->var_rank
)
2410 if (nml_parse_qualifier (dtp
, nl
->dim
, nl
->ls
, nl
->var_rank
,
2411 parse_err_msg
) == FAILURE
)
2413 st_sprintf (nml_err_msg
, "%s for namelist variable %s",
2414 parse_err_msg
, nl
->var_name
);
2417 c
= next_char (dtp
);
2418 unget_char (dtp
, c
);
2421 /* Now parse a derived type component. The root namelist_info address
2422 is backed up, as is the previous component level. The component flag
2423 is set and the iteration is made by jumping back to get_name. */
2428 if (nl
->type
!= GFC_DTYPE_DERIVED
)
2430 st_sprintf (nml_err_msg
, "Attempt to get derived component for %s",
2435 if (!component_flag
)
2440 c
= next_char (dtp
);
2445 /* Parse a character qualifier, if present. chigh = 0 is a default
2446 that signals that the string length = string_length. */
2451 if (c
== '(' && nl
->type
== GFC_DTYPE_CHARACTER
)
2453 descriptor_dimension chd
[1] = { {1, clow
, nl
->string_length
} };
2454 array_loop_spec ind
[1] = { {1, clow
, nl
->string_length
, 1} };
2456 if (nml_parse_qualifier (dtp
, chd
, ind
, 1, parse_err_msg
) == FAILURE
)
2458 st_sprintf (nml_err_msg
, "%s for namelist variable %s",
2459 parse_err_msg
, nl
->var_name
);
2463 clow
= ind
[0].start
;
2466 if (ind
[0].step
!= 1)
2468 st_sprintf (nml_err_msg
,
2469 "Bad step in substring for namelist object %s",
2474 c
= next_char (dtp
);
2475 unget_char (dtp
, c
);
2478 /* If a derived type touch its components and restore the root
2479 namelist_info if we have parsed a qualified derived type
2482 if (nl
->type
== GFC_DTYPE_DERIVED
)
2483 nml_touch_nodes (nl
);
2487 /*make sure no extraneous qualifiers are there.*/
2491 st_sprintf (nml_err_msg
, "Qualifier for a scalar or non-character"
2492 " namelist object %s", nl
->var_name
);
2496 /* According to the standard, an equal sign MUST follow an object name. The
2497 following is possibly lax - it allows comments, blank lines and so on to
2498 intervene. eat_spaces (dtp); c = next_char (dtp); would be compliant*/
2502 eat_separator (dtp
);
2503 if (dtp
->u
.p
.input_complete
)
2506 if (dtp
->u
.p
.at_eol
)
2507 finish_separator (dtp
);
2508 if (dtp
->u
.p
.input_complete
)
2511 c
= next_char (dtp
);
2515 st_sprintf (nml_err_msg
, "Equal sign must follow namelist object name %s",
2520 if (nml_read_obj (dtp
, nl
, 0, pprev_nl
, nml_err_msg
, clow
, chigh
) == FAILURE
)
2530 /* Entry point for namelist input. Goes through input until namelist name
2531 is matched. Then cycles through nml_get_obj_data until the input is
2532 completed or there is an error. */
2535 namelist_read (st_parameter_dt
*dtp
)
2539 char nml_err_msg
[100];
2540 /* Pointer to the previously read object, in case attempt is made to read
2541 new object name. Should this fail, error message can give previous
2543 namelist_info
*prev_nl
= NULL
;
2545 dtp
->u
.p
.namelist_mode
= 1;
2546 dtp
->u
.p
.input_complete
= 0;
2547 dtp
->u
.p
.expanded_read
= 0;
2549 dtp
->u
.p
.eof_jump
= &eof_jump
;
2550 if (setjmp (eof_jump
))
2552 dtp
->u
.p
.eof_jump
= NULL
;
2553 generate_error (&dtp
->common
, ERROR_END
, NULL
);
2557 /* Look for &namelist_name . Skip all characters, testing for $nmlname.
2558 Exit on success or EOF. If '?' or '=?' encountered in stdin, print
2559 node names or namelist on stdout. */
2562 switch (c
= next_char (dtp
))
2569 c
= next_char (dtp
);
2571 nml_query (dtp
, '=');
2573 unget_char (dtp
, c
);
2577 nml_query (dtp
, '?');
2583 /* Match the name of the namelist. */
2585 nml_match_name (dtp
, dtp
->namelist_name
, dtp
->namelist_name_len
);
2587 if (dtp
->u
.p
.nml_read_error
)
2590 /* Ready to read namelist objects. If there is an error in input
2591 from stdin, output the error message and continue. */
2593 while (!dtp
->u
.p
.input_complete
)
2595 if (nml_get_obj_data (dtp
, &prev_nl
, nml_err_msg
) == FAILURE
)
2599 if (dtp
->u
.p
.current_unit
->unit_number
!= options
.stdin_unit
)
2602 u
= find_unit (options
.stderr_unit
);
2603 st_printf ("%s\n", nml_err_msg
);
2613 dtp
->u
.p
.eof_jump
= NULL
;
2618 /* All namelist error calls return from here */
2622 dtp
->u
.p
.eof_jump
= NULL
;
2625 generate_error (&dtp
->common
, ERROR_READ_VALUE
, nml_err_msg
);