1 /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
2 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
4 F2003 I/O support contributed by Jerry DeLisle
6 This file is part of the GNU Fortran runtime library (libgfortran).
8 Libgfortran is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 Libgfortran is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 Under Section 7 of GPL version 3, you are granted additional
19 permissions described in the GCC Runtime Library Exception, version
20 3.1, as published by the Free Software Foundation.
22 You should have received a copy of the GNU General Public License and
23 a copy of the GCC Runtime Library Exception along with this program;
24 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
25 <http://www.gnu.org/licenses/>. */
28 /* format.c-- parse a FORMAT string into a binary format suitable for
29 * interpretation during I/O statements */
39 static const fnode colon_node
= { FMT_COLON
, 0, NULL
, NULL
, {{ 0, 0, 0 }}, 0,
44 static const char posint_required
[] = "Positive width required in format",
45 period_required
[] = "Period required in format",
46 nonneg_required
[] = "Nonnegative width required in format",
47 unexpected_element
[] = "Unexpected element '%c' in format\n",
48 unexpected_end
[] = "Unexpected end of format string",
49 bad_string
[] = "Unterminated character constant in format",
50 bad_hollerith
[] = "Hollerith constant extends past the end of the format",
51 reversion_error
[] = "Exhausted data descriptors in format",
52 zero_width
[] = "Zero width in format descriptor";
54 /* The following routines support caching format data from parsed format strings
55 into a hash table. This avoids repeatedly parsing duplicate format strings
56 or format strings in I/O statements that are repeated in loops. */
59 /* Traverse the table and free all data. */
62 free_format_hash_table (gfc_unit
*u
)
66 /* free_format_data handles any NULL pointers. */
67 for (i
= 0; i
< FORMAT_HASH_SIZE
; i
++)
69 if (u
->format_hash_table
[i
].hashed_fmt
!= NULL
)
71 free_format_data (u
->format_hash_table
[i
].hashed_fmt
);
72 free (u
->format_hash_table
[i
].key
);
74 u
->format_hash_table
[i
].key
= NULL
;
75 u
->format_hash_table
[i
].key_len
= 0;
76 u
->format_hash_table
[i
].hashed_fmt
= NULL
;
80 /* Traverse the format_data structure and reset the fnode counters. */
83 reset_node (fnode
*fn
)
90 if (fn
->format
!= FMT_LPAREN
)
93 for (f
= fn
->u
.child
; f
; f
= f
->next
)
95 if (f
->format
== FMT_RPAREN
)
102 reset_fnode_counters (st_parameter_dt
*dtp
)
109 /* Clear this pointer at the head so things start at the right place. */
110 fmt
->array
.array
[0].current
= NULL
;
112 for (f
= fmt
->array
.array
[0].u
.child
; f
; f
= f
->next
)
117 /* A simple hashing function to generate an index into the hash table. */
120 uint32_t format_hash (st_parameter_dt
*dtp
)
123 gfc_charlen_type key_len
;
127 /* Hash the format string. Super simple, but what the heck! */
129 key_len
= dtp
->format_len
;
130 for (i
= 0; i
< key_len
; i
++)
132 hash
&= (FORMAT_HASH_SIZE
- 1);
138 save_parsed_format (st_parameter_dt
*dtp
)
143 hash
= format_hash (dtp
);
144 u
= dtp
->u
.p
.current_unit
;
146 /* Index into the hash table. We are simply replacing whatever is there
147 relying on probability. */
148 if (u
->format_hash_table
[hash
].hashed_fmt
!= NULL
)
149 free_format_data (u
->format_hash_table
[hash
].hashed_fmt
);
150 u
->format_hash_table
[hash
].hashed_fmt
= NULL
;
152 if (u
->format_hash_table
[hash
].key
!= NULL
)
153 free (u
->format_hash_table
[hash
].key
);
154 u
->format_hash_table
[hash
].key
= get_mem (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
= get_mem (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
;
1130 char *p
, buffer
[300];
1131 format_data
*fmt
= dtp
->u
.p
.fmt
;
1134 fmt
->format_string
= f
->source
;
1136 if (message
== unexpected_element
)
1137 sprintf (buffer
, message
, fmt
->error_element
);
1139 sprintf (buffer
, "%s\n", message
);
1141 j
= fmt
->format_string
- dtp
->format
;
1143 offset
= (j
> 60) ? j
- 40 : 0;
1146 width
= dtp
->format_len
- offset
;
1151 /* Show the format */
1153 p
= strchr (buffer
, '\0');
1155 memcpy (p
, dtp
->format
+ offset
, width
);
1160 /* Show where the problem is */
1162 for (i
= 1; i
< j
; i
++)
1168 generate_error (&dtp
->common
, LIBERROR_FORMAT
, buffer
);
1172 /* revert()-- Do reversion of the format. Control reverts to the left
1173 * parenthesis that matches the rightmost right parenthesis. From our
1174 * tree structure, we are looking for the rightmost parenthesis node
1175 * at the second level, the first level always being a single
1176 * parenthesis node. If this node doesn't exit, we use the top
1180 revert (st_parameter_dt
*dtp
)
1183 format_data
*fmt
= dtp
->u
.p
.fmt
;
1185 dtp
->u
.p
.reversion_flag
= 1;
1189 for (f
= fmt
->array
.array
[0].u
.child
; f
; f
= f
->next
)
1190 if (f
->format
== FMT_LPAREN
)
1193 /* If r is NULL because no node was found, the whole tree will be used */
1195 fmt
->array
.array
[0].current
= r
;
1196 fmt
->array
.array
[0].count
= 0;
1199 /* parse_format()-- Parse a format string. */
1202 parse_format (st_parameter_dt
*dtp
)
1205 bool format_cache_ok
, seen_data_desc
= false;
1207 /* Don't cache for internal units and set an arbitrary limit on the size of
1208 format strings we will cache. (Avoids memory issues.) */
1209 format_cache_ok
= !is_internal_unit (dtp
);
1211 /* Lookup format string to see if it has already been parsed. */
1212 if (format_cache_ok
)
1214 dtp
->u
.p
.fmt
= find_parsed_format (dtp
);
1216 if (dtp
->u
.p
.fmt
!= NULL
)
1218 dtp
->u
.p
.fmt
->reversion_ok
= 0;
1219 dtp
->u
.p
.fmt
->saved_token
= FMT_NONE
;
1220 dtp
->u
.p
.fmt
->saved_format
= NULL
;
1221 reset_fnode_counters (dtp
);
1226 /* Not found so proceed as follows. */
1228 dtp
->u
.p
.fmt
= fmt
= get_mem (sizeof (format_data
));
1229 fmt
->format_string
= dtp
->format
;
1230 fmt
->format_string_len
= dtp
->format_len
;
1233 fmt
->saved_token
= FMT_NONE
;
1237 /* Initialize variables used during traversal of the tree. */
1239 fmt
->reversion_ok
= 0;
1240 fmt
->saved_format
= NULL
;
1242 /* Allocate the first format node as the root of the tree. */
1244 fmt
->last
= &fmt
->array
;
1245 fmt
->last
->next
= NULL
;
1246 fmt
->avail
= &fmt
->array
.array
[0];
1248 memset (fmt
->avail
, 0, sizeof (*fmt
->avail
));
1249 fmt
->avail
->format
= FMT_LPAREN
;
1250 fmt
->avail
->repeat
= 1;
1253 if (format_lex (fmt
) == FMT_LPAREN
)
1254 fmt
->array
.array
[0].u
.child
= parse_format_list (dtp
, &format_cache_ok
,
1257 fmt
->error
= "Missing initial left parenthesis in format";
1261 format_error (dtp
, NULL
, fmt
->error
);
1262 free_format_hash_table (dtp
->u
.p
.current_unit
);
1266 if (format_cache_ok
)
1267 save_parsed_format (dtp
);
1269 dtp
->u
.p
.format_not_saved
= 1;
1273 /* next_format0()-- Get the next format node without worrying about
1274 * reversion. Returns NULL when we hit the end of the list.
1275 * Parenthesis nodes are incremented after the list has been
1276 * exhausted, other nodes are incremented before they are returned. */
1278 static const fnode
*
1279 next_format0 (fnode
* f
)
1286 if (f
->format
!= FMT_LPAREN
)
1289 if (f
->count
<= f
->repeat
)
1296 /* Deal with a parenthesis node with unlimited format. */
1298 if (f
->repeat
== -2) /* -2 signifies unlimited. */
1301 if (f
->current
== NULL
)
1302 f
->current
= f
->u
.child
;
1304 for (; f
->current
!= NULL
; f
->current
= f
->current
->next
)
1306 r
= next_format0 (f
->current
);
1312 /* Deal with a parenthesis node with specific repeat count. */
1313 for (; f
->count
< f
->repeat
; f
->count
++)
1315 if (f
->current
== NULL
)
1316 f
->current
= f
->u
.child
;
1318 for (; f
->current
!= NULL
; f
->current
= f
->current
->next
)
1320 r
= next_format0 (f
->current
);
1331 /* next_format()-- Return the next format node. If the format list
1332 * ends up being exhausted, we do reversion. Reversion is only
1333 * allowed if we've seen a data descriptor since the
1334 * initialization or the last reversion. We return NULL if there
1335 * are no more data descriptors to return (which is an error
1339 next_format (st_parameter_dt
*dtp
)
1343 format_data
*fmt
= dtp
->u
.p
.fmt
;
1345 if (fmt
->saved_format
!= NULL
)
1346 { /* Deal with a pushed-back format node */
1347 f
= fmt
->saved_format
;
1348 fmt
->saved_format
= NULL
;
1352 f
= next_format0 (&fmt
->array
.array
[0]);
1355 if (!fmt
->reversion_ok
)
1358 fmt
->reversion_ok
= 0;
1361 f
= next_format0 (&fmt
->array
.array
[0]);
1364 format_error (dtp
, NULL
, reversion_error
);
1368 /* Push the first reverted token and return a colon node in case
1369 * there are no more data items. */
1371 fmt
->saved_format
= f
;
1375 /* If this is a data edit descriptor, then reversion has become OK. */
1379 if (!fmt
->reversion_ok
&&
1380 (t
== FMT_I
|| t
== FMT_B
|| t
== FMT_O
|| t
== FMT_Z
|| t
== FMT_F
||
1381 t
== FMT_E
|| t
== FMT_EN
|| t
== FMT_ES
|| t
== FMT_G
|| t
== FMT_L
||
1382 t
== FMT_A
|| t
== FMT_D
))
1383 fmt
->reversion_ok
= 1;
1388 /* unget_format()-- Push the given format back so that it will be
1389 * returned on the next call to next_format() without affecting
1390 * counts. This is necessary when we've encountered a data
1391 * descriptor, but don't know what the data item is yet. The format
1392 * node is pushed back, and we return control to the main program,
1393 * which calls the library back with the data item (or not). */
1396 unget_format (st_parameter_dt
*dtp
, const fnode
*f
)
1398 dtp
->u
.p
.fmt
->saved_format
= f
;