1 /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011,
3 Free Software Foundation, Inc.
4 Contributed by Andy Vaught
5 F2003 I/O support contributed by Jerry DeLisle
7 This file is part of the GNU Fortran runtime library (libgfortran).
9 Libgfortran is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 3, or (at your option)
14 Libgfortran is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 Under Section 7 of GPL version 3, you are granted additional
20 permissions described in the GCC Runtime Library Exception, version
21 3.1, as published by the Free Software Foundation.
23 You should have received a copy of the GNU General Public License and
24 a copy of the GCC Runtime Library Exception along with this program;
25 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
26 <http://www.gnu.org/licenses/>. */
29 /* format.c-- parse a FORMAT string into a binary format suitable for
30 * interpretation during I/O statements */
40 static const fnode colon_node
= { FMT_COLON
, 0, NULL
, NULL
, {{ 0, 0, 0 }}, 0,
45 static const char posint_required
[] = "Positive width required in format",
46 period_required
[] = "Period required in format",
47 nonneg_required
[] = "Nonnegative width required in format",
48 unexpected_element
[] = "Unexpected element '%c' in format\n",
49 unexpected_end
[] = "Unexpected end of format string",
50 bad_string
[] = "Unterminated character constant in format",
51 bad_hollerith
[] = "Hollerith constant extends past the end of the format",
52 reversion_error
[] = "Exhausted data descriptors in format",
53 zero_width
[] = "Zero width in format descriptor";
55 /* The following routines support caching format data from parsed format strings
56 into a hash table. This avoids repeatedly parsing duplicate format strings
57 or format strings in I/O statements that are repeated in loops. */
60 /* Traverse the table and free all data. */
63 free_format_hash_table (gfc_unit
*u
)
67 /* free_format_data handles any NULL pointers. */
68 for (i
= 0; i
< FORMAT_HASH_SIZE
; i
++)
70 if (u
->format_hash_table
[i
].hashed_fmt
!= NULL
)
72 free_format_data (u
->format_hash_table
[i
].hashed_fmt
);
73 free (u
->format_hash_table
[i
].key
);
75 u
->format_hash_table
[i
].key
= NULL
;
76 u
->format_hash_table
[i
].key_len
= 0;
77 u
->format_hash_table
[i
].hashed_fmt
= NULL
;
81 /* Traverse the format_data structure and reset the fnode counters. */
84 reset_node (fnode
*fn
)
91 if (fn
->format
!= FMT_LPAREN
)
94 for (f
= fn
->u
.child
; f
; f
= f
->next
)
96 if (f
->format
== FMT_RPAREN
)
103 reset_fnode_counters (st_parameter_dt
*dtp
)
110 /* Clear this pointer at the head so things start at the right place. */
111 fmt
->array
.array
[0].current
= NULL
;
113 for (f
= fmt
->array
.array
[0].u
.child
; f
; f
= f
->next
)
118 /* A simple hashing function to generate an index into the hash table. */
121 format_hash (st_parameter_dt
*dtp
)
124 gfc_charlen_type key_len
;
128 /* Hash the format string. Super simple, but what the heck! */
130 key_len
= dtp
->format_len
;
131 for (i
= 0; i
< key_len
; i
++)
133 hash
&= (FORMAT_HASH_SIZE
- 1);
139 save_parsed_format (st_parameter_dt
*dtp
)
144 hash
= format_hash (dtp
);
145 u
= dtp
->u
.p
.current_unit
;
147 /* Index into the hash table. We are simply replacing whatever is there
148 relying on probability. */
149 if (u
->format_hash_table
[hash
].hashed_fmt
!= NULL
)
150 free_format_data (u
->format_hash_table
[hash
].hashed_fmt
);
151 u
->format_hash_table
[hash
].hashed_fmt
= NULL
;
153 free (u
->format_hash_table
[hash
].key
);
154 u
->format_hash_table
[hash
].key
= xmalloc (dtp
->format_len
);
155 memcpy (u
->format_hash_table
[hash
].key
, dtp
->format
, dtp
->format_len
);
157 u
->format_hash_table
[hash
].key_len
= dtp
->format_len
;
158 u
->format_hash_table
[hash
].hashed_fmt
= dtp
->u
.p
.fmt
;
163 find_parsed_format (st_parameter_dt
*dtp
)
168 hash
= format_hash (dtp
);
169 u
= dtp
->u
.p
.current_unit
;
171 if (u
->format_hash_table
[hash
].key
!= NULL
)
173 /* See if it matches. */
174 if (u
->format_hash_table
[hash
].key_len
== dtp
->format_len
)
176 /* So far so good. */
177 if (strncmp (u
->format_hash_table
[hash
].key
,
178 dtp
->format
, dtp
->format_len
) == 0)
179 return u
->format_hash_table
[hash
].hashed_fmt
;
186 /* next_char()-- Return the next character in the format string.
187 * Returns -1 when the string is done. If the literal flag is set,
188 * spaces are significant, otherwise they are not. */
191 next_char (format_data
*fmt
, int literal
)
197 if (fmt
->format_string_len
== 0)
200 fmt
->format_string_len
--;
201 c
= toupper (*fmt
->format_string
++);
202 fmt
->error_element
= c
;
204 while ((c
== ' ' || c
== '\t') && !literal
);
210 /* unget_char()-- Back up one character position. */
212 #define unget_char(fmt) \
213 { fmt->format_string--; fmt->format_string_len++; }
216 /* get_fnode()-- Allocate a new format node, inserting it into the
217 * current singly linked list. These are initially allocated from the
221 get_fnode (format_data
*fmt
, fnode
**head
, fnode
**tail
, format_token t
)
225 if (fmt
->avail
== &fmt
->last
->array
[FARRAY_SIZE
])
227 fmt
->last
->next
= xmalloc (sizeof (fnode_array
));
228 fmt
->last
= fmt
->last
->next
;
229 fmt
->last
->next
= NULL
;
230 fmt
->avail
= &fmt
->last
->array
[0];
233 memset (f
, '\0', sizeof (fnode
));
245 f
->source
= fmt
->format_string
;
250 /* free_format_data()-- Free all allocated format data. */
253 free_format_data (format_data
*fmt
)
255 fnode_array
*fa
, *fa_next
;
261 for (fa
= fmt
->array
.next
; fa
; fa
= fa_next
)
272 /* format_lex()-- Simple lexical analyzer for getting the next token
273 * in a FORMAT string. We support a one-level token pushback in the
274 * fmt->saved_token variable. */
277 format_lex (format_data
*fmt
)
284 if (fmt
->saved_token
!= FMT_NONE
)
286 token
= fmt
->saved_token
;
287 fmt
->saved_token
= FMT_NONE
;
292 c
= next_char (fmt
, 0);
313 c
= next_char (fmt
, 0);
320 fmt
->value
= c
- '0';
324 c
= next_char (fmt
, 0);
328 fmt
->value
= 10 * fmt
->value
+ c
- '0';
334 fmt
->value
= -fmt
->value
;
335 token
= FMT_SIGNED_INT
;
348 fmt
->value
= c
- '0';
352 c
= next_char (fmt
, 0);
356 fmt
->value
= 10 * fmt
->value
+ c
- '0';
360 token
= (fmt
->value
== 0) ? FMT_ZERO
: FMT_POSINT
;
384 switch (next_char (fmt
, 0))
405 switch (next_char (fmt
, 0))
422 switch (next_char (fmt
, 0))
442 fmt
->string
= fmt
->format_string
;
443 fmt
->value
= 0; /* This is the length of the string */
447 c
= next_char (fmt
, 1);
450 token
= FMT_BADSTRING
;
451 fmt
->error
= bad_string
;
457 c
= next_char (fmt
, 1);
461 token
= FMT_BADSTRING
;
462 fmt
->error
= bad_string
;
500 switch (next_char (fmt
, 0))
532 switch (next_char (fmt
, 0))
548 switch (next_char (fmt
, 0))
588 /* parse_format_list()-- Parse a format list. Assumes that a left
589 * paren has already been seen. Returns a list representing the
590 * parenthesis node which contains the rest of the list. */
593 parse_format_list (st_parameter_dt
*dtp
, bool *save_ok
, bool *seen_dd
)
596 format_token t
, u
, t2
;
598 format_data
*fmt
= dtp
->u
.p
.fmt
;
599 bool saveit
, seen_data_desc
= false;
604 /* Get the next format item */
606 t
= format_lex (fmt
);
611 t
= format_lex (fmt
);
614 fmt
->error
= "Left parenthesis required after '*'";
617 get_fnode (fmt
, &head
, &tail
, FMT_LPAREN
);
618 tail
->repeat
= -2; /* Signifies unlimited format. */
619 tail
->u
.child
= parse_format_list (dtp
, &saveit
, &seen_data_desc
);
620 if (fmt
->error
!= NULL
)
624 fmt
->error
= "'*' requires at least one associated data descriptor";
632 t
= format_lex (fmt
);
636 get_fnode (fmt
, &head
, &tail
, FMT_LPAREN
);
637 tail
->repeat
= repeat
;
638 tail
->u
.child
= parse_format_list (dtp
, &saveit
, &seen_data_desc
);
639 *seen_dd
= seen_data_desc
;
640 if (fmt
->error
!= NULL
)
646 get_fnode (fmt
, &head
, &tail
, FMT_SLASH
);
647 tail
->repeat
= repeat
;
651 get_fnode (fmt
, &head
, &tail
, FMT_X
);
653 tail
->u
.k
= fmt
->value
;
664 get_fnode (fmt
, &head
, &tail
, FMT_LPAREN
);
666 tail
->u
.child
= parse_format_list (dtp
, &saveit
, &seen_data_desc
);
667 *seen_dd
= seen_data_desc
;
668 if (fmt
->error
!= NULL
)
673 case FMT_SIGNED_INT
: /* Signed integer can only precede a P format. */
674 case FMT_ZERO
: /* Same for zero. */
675 t
= format_lex (fmt
);
678 fmt
->error
= "Expected P edit descriptor in format";
683 get_fnode (fmt
, &head
, &tail
, FMT_P
);
684 tail
->u
.k
= fmt
->value
;
687 t
= format_lex (fmt
);
688 if (t
== FMT_F
|| t
== FMT_EN
|| t
== FMT_ES
|| t
== FMT_D
689 || t
== FMT_G
|| t
== FMT_E
)
695 if (t
!= FMT_COMMA
&& t
!= FMT_RPAREN
&& t
!= FMT_SLASH
698 fmt
->error
= "Comma required after P descriptor";
702 fmt
->saved_token
= t
;
705 case FMT_P
: /* P and X require a prior number */
706 fmt
->error
= "P descriptor requires leading scale factor";
713 If we would be pedantic in the library, we would have to reject
714 an X descriptor without an integer prefix:
716 fmt->error = "X descriptor requires leading space count";
719 However, this is an extension supported by many Fortran compilers,
720 including Cray, HP, AIX, and IRIX. Therefore, we allow it in the
721 runtime library, and make the front end reject it if the compiler
722 is in pedantic mode. The interpretation of 'X' is '1X'.
724 get_fnode (fmt
, &head
, &tail
, FMT_X
);
730 /* TODO: Find out why it is necessary to turn off format caching. */
732 get_fnode (fmt
, &head
, &tail
, FMT_STRING
);
733 tail
->u
.string
.p
= fmt
->string
;
734 tail
->u
.string
.length
= fmt
->value
;
744 notify_std (&dtp
->common
, GFC_STD_F2003
, "Fortran 2003: Round "
745 "descriptor not allowed");
746 get_fnode (fmt
, &head
, &tail
, t
);
752 notify_std (&dtp
->common
, GFC_STD_F2003
, "Fortran 2003: DC or DP "
753 "descriptor not allowed");
760 get_fnode (fmt
, &head
, &tail
, t
);
765 get_fnode (fmt
, &head
, &tail
, FMT_COLON
);
770 get_fnode (fmt
, &head
, &tail
, FMT_SLASH
);
776 get_fnode (fmt
, &head
, &tail
, FMT_DOLLAR
);
778 notify_std (&dtp
->common
, GFC_STD_GNU
, "Extension: $ descriptor");
784 t2
= format_lex (fmt
);
785 if (t2
!= FMT_POSINT
)
787 fmt
->error
= posint_required
;
790 get_fnode (fmt
, &head
, &tail
, t
);
791 tail
->u
.n
= fmt
->value
;
812 get_fnode (fmt
, &head
, &tail
, FMT_STRING
);
813 if (fmt
->format_string_len
< 1)
815 fmt
->error
= bad_hollerith
;
819 tail
->u
.string
.p
= fmt
->format_string
;
820 tail
->u
.string
.length
= 1;
823 fmt
->format_string
++;
824 fmt
->format_string_len
--;
829 fmt
->error
= unexpected_end
;
839 fmt
->error
= unexpected_element
;
843 /* In this state, t must currently be a data descriptor. Deal with
844 things that can/must follow the descriptor */
849 t
= format_lex (fmt
);
852 if (notification_std(GFC_STD_GNU
) == NOTIFICATION_ERROR
)
854 fmt
->error
= posint_required
;
859 fmt
->saved_token
= t
;
860 fmt
->value
= 1; /* Default width */
861 notify_std (&dtp
->common
, GFC_STD_GNU
, posint_required
);
865 get_fnode (fmt
, &head
, &tail
, FMT_L
);
866 tail
->u
.n
= fmt
->value
;
867 tail
->repeat
= repeat
;
871 t
= format_lex (fmt
);
874 fmt
->error
= zero_width
;
880 fmt
->saved_token
= t
;
881 fmt
->value
= -1; /* Width not present */
884 get_fnode (fmt
, &head
, &tail
, FMT_A
);
885 tail
->repeat
= repeat
;
886 tail
->u
.n
= fmt
->value
;
895 get_fnode (fmt
, &head
, &tail
, t
);
896 tail
->repeat
= repeat
;
898 u
= format_lex (fmt
);
899 if (t
== FMT_G
&& u
== FMT_ZERO
)
901 if (notification_std (GFC_STD_F2008
) == NOTIFICATION_ERROR
902 || dtp
->u
.p
.mode
== READING
)
904 fmt
->error
= zero_width
;
908 u
= format_lex (fmt
);
911 fmt
->saved_token
= u
;
915 u
= format_lex (fmt
);
918 fmt
->error
= posint_required
;
921 tail
->u
.real
.d
= fmt
->value
;
924 if (t
== FMT_F
&& dtp
->u
.p
.mode
== WRITING
)
926 if (u
!= FMT_POSINT
&& u
!= FMT_ZERO
)
928 fmt
->error
= nonneg_required
;
932 else if (u
!= FMT_POSINT
)
934 fmt
->error
= posint_required
;
938 tail
->u
.real
.w
= fmt
->value
;
940 t
= format_lex (fmt
);
943 /* We treat a missing decimal descriptor as 0. Note: This is only
944 allowed if -std=legacy, otherwise an error occurs. */
945 if (compile_options
.warn_std
!= 0)
947 fmt
->error
= period_required
;
950 fmt
->saved_token
= t
;
956 t
= format_lex (fmt
);
957 if (t
!= FMT_ZERO
&& t
!= FMT_POSINT
)
959 fmt
->error
= nonneg_required
;
963 tail
->u
.real
.d
= fmt
->value
;
966 if (t2
== FMT_D
|| t2
== FMT_F
)
970 /* Look for optional exponent */
971 t
= format_lex (fmt
);
973 fmt
->saved_token
= t
;
976 t
= format_lex (fmt
);
979 fmt
->error
= "Positive exponent width required in format";
983 tail
->u
.real
.e
= fmt
->value
;
989 if (repeat
> fmt
->format_string_len
)
991 fmt
->error
= bad_hollerith
;
995 get_fnode (fmt
, &head
, &tail
, FMT_STRING
);
996 tail
->u
.string
.p
= fmt
->format_string
;
997 tail
->u
.string
.length
= repeat
;
1000 fmt
->format_string
+= fmt
->value
;
1001 fmt
->format_string_len
-= repeat
;
1009 get_fnode (fmt
, &head
, &tail
, t
);
1010 tail
->repeat
= repeat
;
1012 t
= format_lex (fmt
);
1014 if (dtp
->u
.p
.mode
== READING
)
1016 if (t
!= FMT_POSINT
)
1018 fmt
->error
= posint_required
;
1024 if (t
!= FMT_ZERO
&& t
!= FMT_POSINT
)
1026 fmt
->error
= nonneg_required
;
1031 tail
->u
.integer
.w
= fmt
->value
;
1032 tail
->u
.integer
.m
= -1;
1034 t
= format_lex (fmt
);
1035 if (t
!= FMT_PERIOD
)
1037 fmt
->saved_token
= t
;
1041 t
= format_lex (fmt
);
1042 if (t
!= FMT_ZERO
&& t
!= FMT_POSINT
)
1044 fmt
->error
= nonneg_required
;
1048 tail
->u
.integer
.m
= fmt
->value
;
1051 if (tail
->u
.integer
.w
!= 0 && tail
->u
.integer
.m
> tail
->u
.integer
.w
)
1053 fmt
->error
= "Minimum digits exceeds field width";
1060 fmt
->error
= unexpected_element
;
1064 /* Between a descriptor and what comes next */
1066 t
= format_lex (fmt
);
1077 get_fnode (fmt
, &head
, &tail
, t
);
1079 goto optional_comma
;
1082 fmt
->error
= unexpected_end
;
1086 /* Assume a missing comma, this is a GNU extension */
1090 /* Optional comma is a weird between state where we've just finished
1091 reading a colon, slash or P descriptor. */
1093 t
= format_lex (fmt
);
1102 default: /* Assume that we have another format item */
1103 fmt
->saved_token
= t
;
1117 /* format_error()-- Generate an error message for a format statement.
1118 * If the node that gives the location of the error is NULL, the error
1119 * is assumed to happen at parse time, and the current location of the
1122 * We generate a message showing where the problem is. We take extra
1123 * care to print only the relevant part of the format if it is longer
1124 * than a standard 80 column display. */
1127 format_error (st_parameter_dt
*dtp
, const fnode
*f
, const char *message
)
1129 int width
, i
, j
, offset
;
1131 char *p
, buffer
[BUFLEN
];
1132 format_data
*fmt
= dtp
->u
.p
.fmt
;
1135 fmt
->format_string
= f
->source
;
1137 if (message
== unexpected_element
)
1138 snprintf (buffer
, BUFLEN
, message
, fmt
->error_element
);
1140 snprintf (buffer
, BUFLEN
, "%s\n", message
);
1142 j
= fmt
->format_string
- dtp
->format
;
1144 offset
= (j
> 60) ? j
- 40 : 0;
1147 width
= dtp
->format_len
- offset
;
1152 /* Show the format */
1154 p
= strchr (buffer
, '\0');
1156 memcpy (p
, dtp
->format
+ offset
, width
);
1161 /* Show where the problem is */
1163 for (i
= 1; i
< j
; i
++)
1169 generate_error (&dtp
->common
, LIBERROR_FORMAT
, buffer
);
1173 /* revert()-- Do reversion of the format. Control reverts to the left
1174 * parenthesis that matches the rightmost right parenthesis. From our
1175 * tree structure, we are looking for the rightmost parenthesis node
1176 * at the second level, the first level always being a single
1177 * parenthesis node. If this node doesn't exit, we use the top
1181 revert (st_parameter_dt
*dtp
)
1184 format_data
*fmt
= dtp
->u
.p
.fmt
;
1186 dtp
->u
.p
.reversion_flag
= 1;
1190 for (f
= fmt
->array
.array
[0].u
.child
; f
; f
= f
->next
)
1191 if (f
->format
== FMT_LPAREN
)
1194 /* If r is NULL because no node was found, the whole tree will be used */
1196 fmt
->array
.array
[0].current
= r
;
1197 fmt
->array
.array
[0].count
= 0;
1200 /* parse_format()-- Parse a format string. */
1203 parse_format (st_parameter_dt
*dtp
)
1206 bool format_cache_ok
, seen_data_desc
= false;
1208 /* Don't cache for internal units and set an arbitrary limit on the size of
1209 format strings we will cache. (Avoids memory issues.) */
1210 format_cache_ok
= !is_internal_unit (dtp
);
1212 /* Lookup format string to see if it has already been parsed. */
1213 if (format_cache_ok
)
1215 dtp
->u
.p
.fmt
= find_parsed_format (dtp
);
1217 if (dtp
->u
.p
.fmt
!= NULL
)
1219 dtp
->u
.p
.fmt
->reversion_ok
= 0;
1220 dtp
->u
.p
.fmt
->saved_token
= FMT_NONE
;
1221 dtp
->u
.p
.fmt
->saved_format
= NULL
;
1222 reset_fnode_counters (dtp
);
1227 /* Not found so proceed as follows. */
1229 dtp
->u
.p
.fmt
= fmt
= xmalloc (sizeof (format_data
));
1230 fmt
->format_string
= dtp
->format
;
1231 fmt
->format_string_len
= dtp
->format_len
;
1234 fmt
->saved_token
= FMT_NONE
;
1238 /* Initialize variables used during traversal of the tree. */
1240 fmt
->reversion_ok
= 0;
1241 fmt
->saved_format
= NULL
;
1243 /* Allocate the first format node as the root of the tree. */
1245 fmt
->last
= &fmt
->array
;
1246 fmt
->last
->next
= NULL
;
1247 fmt
->avail
= &fmt
->array
.array
[0];
1249 memset (fmt
->avail
, 0, sizeof (*fmt
->avail
));
1250 fmt
->avail
->format
= FMT_LPAREN
;
1251 fmt
->avail
->repeat
= 1;
1254 if (format_lex (fmt
) == FMT_LPAREN
)
1255 fmt
->array
.array
[0].u
.child
= parse_format_list (dtp
, &format_cache_ok
,
1258 fmt
->error
= "Missing initial left parenthesis in format";
1262 format_error (dtp
, NULL
, fmt
->error
);
1263 free_format_hash_table (dtp
->u
.p
.current_unit
);
1267 if (format_cache_ok
)
1268 save_parsed_format (dtp
);
1270 dtp
->u
.p
.format_not_saved
= 1;
1274 /* next_format0()-- Get the next format node without worrying about
1275 * reversion. Returns NULL when we hit the end of the list.
1276 * Parenthesis nodes are incremented after the list has been
1277 * exhausted, other nodes are incremented before they are returned. */
1279 static const fnode
*
1280 next_format0 (fnode
* f
)
1287 if (f
->format
!= FMT_LPAREN
)
1290 if (f
->count
<= f
->repeat
)
1297 /* Deal with a parenthesis node with unlimited format. */
1299 if (f
->repeat
== -2) /* -2 signifies unlimited. */
1302 if (f
->current
== NULL
)
1303 f
->current
= f
->u
.child
;
1305 for (; f
->current
!= NULL
; f
->current
= f
->current
->next
)
1307 r
= next_format0 (f
->current
);
1313 /* Deal with a parenthesis node with specific repeat count. */
1314 for (; f
->count
< f
->repeat
; f
->count
++)
1316 if (f
->current
== NULL
)
1317 f
->current
= f
->u
.child
;
1319 for (; f
->current
!= NULL
; f
->current
= f
->current
->next
)
1321 r
= next_format0 (f
->current
);
1332 /* next_format()-- Return the next format node. If the format list
1333 * ends up being exhausted, we do reversion. Reversion is only
1334 * allowed if we've seen a data descriptor since the
1335 * initialization or the last reversion. We return NULL if there
1336 * are no more data descriptors to return (which is an error
1340 next_format (st_parameter_dt
*dtp
)
1344 format_data
*fmt
= dtp
->u
.p
.fmt
;
1346 if (fmt
->saved_format
!= NULL
)
1347 { /* Deal with a pushed-back format node */
1348 f
= fmt
->saved_format
;
1349 fmt
->saved_format
= NULL
;
1353 f
= next_format0 (&fmt
->array
.array
[0]);
1356 if (!fmt
->reversion_ok
)
1359 fmt
->reversion_ok
= 0;
1362 f
= next_format0 (&fmt
->array
.array
[0]);
1365 format_error (dtp
, NULL
, reversion_error
);
1369 /* Push the first reverted token and return a colon node in case
1370 * there are no more data items. */
1372 fmt
->saved_format
= f
;
1376 /* If this is a data edit descriptor, then reversion has become OK. */
1380 if (!fmt
->reversion_ok
&&
1381 (t
== FMT_I
|| t
== FMT_B
|| t
== FMT_O
|| t
== FMT_Z
|| t
== FMT_F
||
1382 t
== FMT_E
|| t
== FMT_EN
|| t
== FMT_ES
|| t
== FMT_G
|| t
== FMT_L
||
1383 t
== FMT_A
|| t
== FMT_D
))
1384 fmt
->reversion_ok
= 1;
1389 /* unget_format()-- Push the given format back so that it will be
1390 * returned on the next call to next_format() without affecting
1391 * counts. This is necessary when we've encountered a data
1392 * descriptor, but don't know what the data item is yet. The format
1393 * node is pushed back, and we return control to the main program,
1394 * which calls the library back with the data item (or not). */
1397 unget_format (st_parameter_dt
*dtp
, const fnode
*f
)
1399 dtp
->u
.p
.fmt
->saved_format
= f
;