]>
git.ipfire.org Git - thirdparty/gcc.git/blob - libgfortran/io/format.c
1 /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
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 95 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 */
37 #define FARRAY_SIZE 64
39 typedef struct fnode_array
41 struct fnode_array
*next
;
42 fnode array
[FARRAY_SIZE
];
46 typedef struct format_data
48 char *format_string
, *string
;
51 format_token saved_token
;
52 int value
, format_string_len
, reversion_ok
;
54 const fnode
*saved_format
;
60 static const fnode colon_node
= { FMT_COLON
, 0, NULL
, NULL
, {{ 0, 0, 0 }}, 0,
65 static const char posint_required
[] = "Positive width required in format",
66 period_required
[] = "Period required in format",
67 nonneg_required
[] = "Nonnegative width required in format",
68 unexpected_element
[] = "Unexpected element '%c' in format\n",
69 unexpected_end
[] = "Unexpected end of format string",
70 bad_string
[] = "Unterminated character constant in format",
71 bad_hollerith
[] = "Hollerith constant extends past the end of the format",
72 reversion_error
[] = "Exhausted data descriptors in format",
73 zero_width
[] = "Zero width in format descriptor";
75 /* The following routines support caching format data from parsed format strings
76 into a hash table. This avoids repeatedly parsing duplicate format strings
77 or format strings in I/O statements that are repeated in loops. */
80 /* Traverse the table and free all data. */
83 free_format_hash_table (gfc_unit
*u
)
87 /* free_format_data handles any NULL pointers. */
88 for (i
= 0; i
< FORMAT_HASH_SIZE
; i
++)
90 if (u
->format_hash_table
[i
].hashed_fmt
!= NULL
)
92 free_format_data (u
->format_hash_table
[i
].hashed_fmt
);
93 free_mem (u
->format_hash_table
[i
].key
);
95 u
->format_hash_table
[i
].key
= NULL
;
96 u
->format_hash_table
[i
].key_len
= 0;
97 u
->format_hash_table
[i
].hashed_fmt
= NULL
;
101 /* Traverse the format_data structure and reset the fnode counters. */
104 reset_node (fnode
*fn
)
111 if (fn
->format
!= FMT_LPAREN
)
114 for (f
= fn
->u
.child
; f
; f
= f
->next
)
116 if (f
->format
== FMT_RPAREN
)
123 reset_fnode_counters (st_parameter_dt
*dtp
)
130 /* Clear this pointer at the head so things start at the right place. */
131 fmt
->array
.array
[0].current
= NULL
;
133 for (f
= fmt
->array
.array
[0].u
.child
; f
; f
= f
->next
)
138 /* A simple hashing function to generate an index into the hash table. */
141 uint32_t format_hash (st_parameter_dt
*dtp
)
144 gfc_charlen_type key_len
;
148 /* Hash the format string. Super simple, but what the heck! */
150 key_len
= dtp
->format_len
;
151 for (i
= 0; i
< key_len
; i
++)
153 hash
&= (FORMAT_HASH_SIZE
- 1);
159 save_parsed_format (st_parameter_dt
*dtp
)
164 hash
= format_hash (dtp
);
165 u
= dtp
->u
.p
.current_unit
;
167 /* Index into the hash table. We are simply replacing whatever is there
168 relying on probability. */
169 if (u
->format_hash_table
[hash
].hashed_fmt
!= NULL
)
170 free_format_data (u
->format_hash_table
[hash
].hashed_fmt
);
171 u
->format_hash_table
[hash
].hashed_fmt
= NULL
;
173 if (u
->format_hash_table
[hash
].key
!= NULL
)
174 free_mem (u
->format_hash_table
[hash
].key
);
175 u
->format_hash_table
[hash
].key
= get_mem (dtp
->format_len
);
176 memcpy (u
->format_hash_table
[hash
].key
, dtp
->format
, dtp
->format_len
);
178 u
->format_hash_table
[hash
].key_len
= dtp
->format_len
;
179 u
->format_hash_table
[hash
].hashed_fmt
= dtp
->u
.p
.fmt
;
184 find_parsed_format (st_parameter_dt
*dtp
)
189 hash
= format_hash (dtp
);
190 u
= dtp
->u
.p
.current_unit
;
192 if (u
->format_hash_table
[hash
].key
!= NULL
)
194 /* See if it matches. */
195 if (u
->format_hash_table
[hash
].key_len
== dtp
->format_len
)
197 /* So far so good. */
198 if (strncmp (u
->format_hash_table
[hash
].key
,
199 dtp
->format
, dtp
->format_len
) == 0)
200 return u
->format_hash_table
[hash
].hashed_fmt
;
207 /* next_char()-- Return the next character in the format string.
208 * Returns -1 when the string is done. If the literal flag is set,
209 * spaces are significant, otherwise they are not. */
212 next_char (format_data
*fmt
, int literal
)
218 if (fmt
->format_string_len
== 0)
221 fmt
->format_string_len
--;
222 c
= toupper (*fmt
->format_string
++);
223 fmt
->error_element
= c
;
225 while ((c
== ' ' || c
== '\t') && !literal
);
231 /* unget_char()-- Back up one character position. */
233 #define unget_char(fmt) \
234 { fmt->format_string--; fmt->format_string_len++; }
237 /* get_fnode()-- Allocate a new format node, inserting it into the
238 * current singly linked list. These are initially allocated from the
242 get_fnode (format_data
*fmt
, fnode
**head
, fnode
**tail
, format_token t
)
246 if (fmt
->avail
== &fmt
->last
->array
[FARRAY_SIZE
])
248 fmt
->last
->next
= get_mem (sizeof (fnode_array
));
249 fmt
->last
= fmt
->last
->next
;
250 fmt
->last
->next
= NULL
;
251 fmt
->avail
= &fmt
->last
->array
[0];
254 memset (f
, '\0', sizeof (fnode
));
266 f
->source
= fmt
->format_string
;
271 /* free_format_data()-- Free all allocated format data. */
274 free_format_data (format_data
*fmt
)
276 fnode_array
*fa
, *fa_next
;
282 for (fa
= fmt
->array
.next
; fa
; fa
= fa_next
)
293 /* format_lex()-- Simple lexical analyzer for getting the next token
294 * in a FORMAT string. We support a one-level token pushback in the
295 * fmt->saved_token variable. */
298 format_lex (format_data
*fmt
)
305 if (fmt
->saved_token
!= FMT_NONE
)
307 token
= fmt
->saved_token
;
308 fmt
->saved_token
= FMT_NONE
;
313 c
= next_char (fmt
, 0);
334 c
= next_char (fmt
, 0);
341 fmt
->value
= c
- '0';
345 c
= next_char (fmt
, 0);
349 fmt
->value
= 10 * fmt
->value
+ c
- '0';
355 fmt
->value
= -fmt
->value
;
356 token
= FMT_SIGNED_INT
;
369 fmt
->value
= c
- '0';
373 c
= next_char (fmt
, 0);
377 fmt
->value
= 10 * fmt
->value
+ c
- '0';
381 token
= (fmt
->value
== 0) ? FMT_ZERO
: FMT_POSINT
;
405 switch (next_char (fmt
, 0))
426 switch (next_char (fmt
, 0))
443 switch (next_char (fmt
, 0))
463 fmt
->string
= fmt
->format_string
;
464 fmt
->value
= 0; /* This is the length of the string */
468 c
= next_char (fmt
, 1);
471 token
= FMT_BADSTRING
;
472 fmt
->error
= bad_string
;
478 c
= next_char (fmt
, 1);
482 token
= FMT_BADSTRING
;
483 fmt
->error
= bad_string
;
521 switch (next_char (fmt
, 0))
553 switch (next_char (fmt
, 0))
569 switch (next_char (fmt
, 0))
609 /* parse_format_list()-- Parse a format list. Assumes that a left
610 * paren has already been seen. Returns a list representing the
611 * parenthesis node which contains the rest of the list. */
614 parse_format_list (st_parameter_dt
*dtp
, bool *save_ok
)
617 format_token t
, u
, t2
;
619 format_data
*fmt
= dtp
->u
.p
.fmt
;
625 /* Get the next format item */
627 t
= format_lex (fmt
);
632 t
= format_lex (fmt
);
635 fmt
->error
= "Left parenthesis required after '*'";
638 get_fnode (fmt
, &head
, &tail
, FMT_LPAREN
);
639 tail
->repeat
= -2; /* Signifies unlimited format. */
640 tail
->u
.child
= parse_format_list (dtp
, &saveit
);
641 if (fmt
->error
!= NULL
)
649 t
= format_lex (fmt
);
653 get_fnode (fmt
, &head
, &tail
, FMT_LPAREN
);
654 tail
->repeat
= repeat
;
655 tail
->u
.child
= parse_format_list (dtp
, &saveit
);
656 if (fmt
->error
!= NULL
)
662 get_fnode (fmt
, &head
, &tail
, FMT_SLASH
);
663 tail
->repeat
= repeat
;
667 get_fnode (fmt
, &head
, &tail
, FMT_X
);
669 tail
->u
.k
= fmt
->value
;
680 get_fnode (fmt
, &head
, &tail
, FMT_LPAREN
);
682 tail
->u
.child
= parse_format_list (dtp
, &saveit
);
683 if (fmt
->error
!= NULL
)
688 case FMT_SIGNED_INT
: /* Signed integer can only precede a P format. */
689 case FMT_ZERO
: /* Same for zero. */
690 t
= format_lex (fmt
);
693 fmt
->error
= "Expected P edit descriptor in format";
698 get_fnode (fmt
, &head
, &tail
, FMT_P
);
699 tail
->u
.k
= fmt
->value
;
702 t
= format_lex (fmt
);
703 if (t
== FMT_F
|| t
== FMT_EN
|| t
== FMT_ES
|| t
== FMT_D
704 || t
== FMT_G
|| t
== FMT_E
)
710 if (t
!= FMT_COMMA
&& t
!= FMT_RPAREN
&& t
!= FMT_SLASH
713 fmt
->error
= "Comma required after P descriptor";
717 fmt
->saved_token
= t
;
720 case FMT_P
: /* P and X require a prior number */
721 fmt
->error
= "P descriptor requires leading scale factor";
728 If we would be pedantic in the library, we would have to reject
729 an X descriptor without an integer prefix:
731 fmt->error = "X descriptor requires leading space count";
734 However, this is an extension supported by many Fortran compilers,
735 including Cray, HP, AIX, and IRIX. Therefore, we allow it in the
736 runtime library, and make the front end reject it if the compiler
737 is in pedantic mode. The interpretation of 'X' is '1X'.
739 get_fnode (fmt
, &head
, &tail
, FMT_X
);
745 /* TODO: Find out why it is necessary to turn off format caching. */
747 get_fnode (fmt
, &head
, &tail
, FMT_STRING
);
748 tail
->u
.string
.p
= fmt
->string
;
749 tail
->u
.string
.length
= fmt
->value
;
759 notify_std (&dtp
->common
, GFC_STD_F2003
, "Fortran 2003: Round "
760 "descriptor not allowed");
761 get_fnode (fmt
, &head
, &tail
, t
);
767 notify_std (&dtp
->common
, GFC_STD_F2003
, "Fortran 2003: DC or DP "
768 "descriptor not allowed");
775 get_fnode (fmt
, &head
, &tail
, t
);
780 get_fnode (fmt
, &head
, &tail
, FMT_COLON
);
785 get_fnode (fmt
, &head
, &tail
, FMT_SLASH
);
791 get_fnode (fmt
, &head
, &tail
, FMT_DOLLAR
);
793 notify_std (&dtp
->common
, GFC_STD_GNU
, "Extension: $ descriptor");
799 t2
= format_lex (fmt
);
800 if (t2
!= FMT_POSINT
)
802 fmt
->error
= posint_required
;
805 get_fnode (fmt
, &head
, &tail
, t
);
806 tail
->u
.n
= fmt
->value
;
826 get_fnode (fmt
, &head
, &tail
, FMT_STRING
);
827 if (fmt
->format_string_len
< 1)
829 fmt
->error
= bad_hollerith
;
833 tail
->u
.string
.p
= fmt
->format_string
;
834 tail
->u
.string
.length
= 1;
837 fmt
->format_string
++;
838 fmt
->format_string_len
--;
843 fmt
->error
= unexpected_end
;
853 fmt
->error
= unexpected_element
;
857 /* In this state, t must currently be a data descriptor. Deal with
858 things that can/must follow the descriptor */
863 t
= format_lex (fmt
);
866 if (notification_std(GFC_STD_GNU
) == NOTIFICATION_ERROR
)
868 fmt
->error
= posint_required
;
873 fmt
->saved_token
= t
;
874 fmt
->value
= 1; /* Default width */
875 notify_std (&dtp
->common
, GFC_STD_GNU
, posint_required
);
879 get_fnode (fmt
, &head
, &tail
, FMT_L
);
880 tail
->u
.n
= fmt
->value
;
881 tail
->repeat
= repeat
;
885 t
= format_lex (fmt
);
888 fmt
->error
= zero_width
;
894 fmt
->saved_token
= t
;
895 fmt
->value
= -1; /* Width not present */
898 get_fnode (fmt
, &head
, &tail
, FMT_A
);
899 tail
->repeat
= repeat
;
900 tail
->u
.n
= fmt
->value
;
909 get_fnode (fmt
, &head
, &tail
, t
);
910 tail
->repeat
= repeat
;
912 u
= format_lex (fmt
);
913 if (t
== FMT_G
&& u
== FMT_ZERO
)
915 if (notification_std (GFC_STD_F2008
) == NOTIFICATION_ERROR
916 || dtp
->u
.p
.mode
== READING
)
918 fmt
->error
= zero_width
;
922 u
= format_lex (fmt
);
925 fmt
->saved_token
= u
;
929 u
= format_lex (fmt
);
932 fmt
->error
= posint_required
;
935 tail
->u
.real
.d
= fmt
->value
;
938 if (t
== FMT_F
&& dtp
->u
.p
.mode
== WRITING
)
940 if (u
!= FMT_POSINT
&& u
!= FMT_ZERO
)
942 fmt
->error
= nonneg_required
;
946 else if (u
!= FMT_POSINT
)
948 fmt
->error
= posint_required
;
952 tail
->u
.real
.w
= fmt
->value
;
954 t
= format_lex (fmt
);
957 /* We treat a missing decimal descriptor as 0. Note: This is only
958 allowed if -std=legacy, otherwise an error occurs. */
959 if (compile_options
.warn_std
!= 0)
961 fmt
->error
= period_required
;
964 fmt
->saved_token
= t
;
970 t
= format_lex (fmt
);
971 if (t
!= FMT_ZERO
&& t
!= FMT_POSINT
)
973 fmt
->error
= nonneg_required
;
977 tail
->u
.real
.d
= fmt
->value
;
980 if (t2
== FMT_D
|| t2
== FMT_F
)
984 /* Look for optional exponent */
985 t
= format_lex (fmt
);
987 fmt
->saved_token
= t
;
990 t
= format_lex (fmt
);
993 fmt
->error
= "Positive exponent width required in format";
997 tail
->u
.real
.e
= fmt
->value
;
1003 if (repeat
> fmt
->format_string_len
)
1005 fmt
->error
= bad_hollerith
;
1009 get_fnode (fmt
, &head
, &tail
, FMT_STRING
);
1010 tail
->u
.string
.p
= fmt
->format_string
;
1011 tail
->u
.string
.length
= repeat
;
1014 fmt
->format_string
+= fmt
->value
;
1015 fmt
->format_string_len
-= repeat
;
1023 get_fnode (fmt
, &head
, &tail
, t
);
1024 tail
->repeat
= repeat
;
1026 t
= format_lex (fmt
);
1028 if (dtp
->u
.p
.mode
== READING
)
1030 if (t
!= FMT_POSINT
)
1032 fmt
->error
= posint_required
;
1038 if (t
!= FMT_ZERO
&& t
!= FMT_POSINT
)
1040 fmt
->error
= nonneg_required
;
1045 tail
->u
.integer
.w
= fmt
->value
;
1046 tail
->u
.integer
.m
= -1;
1048 t
= format_lex (fmt
);
1049 if (t
!= FMT_PERIOD
)
1051 fmt
->saved_token
= t
;
1055 t
= format_lex (fmt
);
1056 if (t
!= FMT_ZERO
&& t
!= FMT_POSINT
)
1058 fmt
->error
= nonneg_required
;
1062 tail
->u
.integer
.m
= fmt
->value
;
1065 if (tail
->u
.integer
.w
!= 0 && tail
->u
.integer
.m
> tail
->u
.integer
.w
)
1067 fmt
->error
= "Minimum digits exceeds field width";
1074 fmt
->error
= unexpected_element
;
1078 /* Between a descriptor and what comes next */
1080 t
= format_lex (fmt
);
1091 get_fnode (fmt
, &head
, &tail
, t
);
1093 goto optional_comma
;
1096 fmt
->error
= unexpected_end
;
1100 /* Assume a missing comma, this is a GNU extension */
1104 /* Optional comma is a weird between state where we've just finished
1105 reading a colon, slash or P descriptor. */
1107 t
= format_lex (fmt
);
1116 default: /* Assume that we have another format item */
1117 fmt
->saved_token
= t
;
1131 /* format_error()-- Generate an error message for a format statement.
1132 * If the node that gives the location of the error is NULL, the error
1133 * is assumed to happen at parse time, and the current location of the
1136 * We generate a message showing where the problem is. We take extra
1137 * care to print only the relevant part of the format if it is longer
1138 * than a standard 80 column display. */
1141 format_error (st_parameter_dt
*dtp
, const fnode
*f
, const char *message
)
1143 int width
, i
, j
, offset
;
1144 char *p
, buffer
[300];
1145 format_data
*fmt
= dtp
->u
.p
.fmt
;
1148 fmt
->format_string
= f
->source
;
1150 if (message
== unexpected_element
)
1151 sprintf (buffer
, message
, fmt
->error_element
);
1153 sprintf (buffer
, "%s\n", message
);
1155 j
= fmt
->format_string
- dtp
->format
;
1157 offset
= (j
> 60) ? j
- 40 : 0;
1160 width
= dtp
->format_len
- offset
;
1165 /* Show the format */
1167 p
= strchr (buffer
, '\0');
1169 memcpy (p
, dtp
->format
+ offset
, width
);
1174 /* Show where the problem is */
1176 for (i
= 1; i
< j
; i
++)
1182 generate_error (&dtp
->common
, LIBERROR_FORMAT
, buffer
);
1186 /* revert()-- Do reversion of the format. Control reverts to the left
1187 * parenthesis that matches the rightmost right parenthesis. From our
1188 * tree structure, we are looking for the rightmost parenthesis node
1189 * at the second level, the first level always being a single
1190 * parenthesis node. If this node doesn't exit, we use the top
1194 revert (st_parameter_dt
*dtp
)
1197 format_data
*fmt
= dtp
->u
.p
.fmt
;
1199 dtp
->u
.p
.reversion_flag
= 1;
1203 for (f
= fmt
->array
.array
[0].u
.child
; f
; f
= f
->next
)
1204 if (f
->format
== FMT_LPAREN
)
1207 /* If r is NULL because no node was found, the whole tree will be used */
1209 fmt
->array
.array
[0].current
= r
;
1210 fmt
->array
.array
[0].count
= 0;
1213 /* parse_format()-- Parse a format string. */
1216 parse_format (st_parameter_dt
*dtp
)
1219 bool format_cache_ok
;
1221 /* Don't cache for internal units and set an arbitrary limit on the size of
1222 format strings we will cache. (Avoids memory issues.) */
1223 format_cache_ok
= !is_internal_unit (dtp
);
1225 /* Lookup format string to see if it has already been parsed. */
1226 if (format_cache_ok
)
1228 dtp
->u
.p
.fmt
= find_parsed_format (dtp
);
1230 if (dtp
->u
.p
.fmt
!= NULL
)
1232 dtp
->u
.p
.fmt
->reversion_ok
= 0;
1233 dtp
->u
.p
.fmt
->saved_token
= FMT_NONE
;
1234 dtp
->u
.p
.fmt
->saved_format
= NULL
;
1235 reset_fnode_counters (dtp
);
1240 /* Not found so proceed as follows. */
1242 dtp
->u
.p
.fmt
= fmt
= get_mem (sizeof (format_data
));
1243 fmt
->format_string
= dtp
->format
;
1244 fmt
->format_string_len
= dtp
->format_len
;
1247 fmt
->saved_token
= FMT_NONE
;
1251 /* Initialize variables used during traversal of the tree. */
1253 fmt
->reversion_ok
= 0;
1254 fmt
->saved_format
= NULL
;
1256 /* Allocate the first format node as the root of the tree. */
1258 fmt
->last
= &fmt
->array
;
1259 fmt
->last
->next
= NULL
;
1260 fmt
->avail
= &fmt
->array
.array
[0];
1262 memset (fmt
->avail
, 0, sizeof (*fmt
->avail
));
1263 fmt
->avail
->format
= FMT_LPAREN
;
1264 fmt
->avail
->repeat
= 1;
1267 if (format_lex (fmt
) == FMT_LPAREN
)
1268 fmt
->array
.array
[0].u
.child
= parse_format_list (dtp
, &format_cache_ok
);
1270 fmt
->error
= "Missing initial left parenthesis in format";
1274 format_error (dtp
, NULL
, fmt
->error
);
1275 free_format_hash_table (dtp
->u
.p
.current_unit
);
1279 if (format_cache_ok
)
1280 save_parsed_format (dtp
);
1282 dtp
->u
.p
.format_not_saved
= 1;
1286 /* next_format0()-- Get the next format node without worrying about
1287 * reversion. Returns NULL when we hit the end of the list.
1288 * Parenthesis nodes are incremented after the list has been
1289 * exhausted, other nodes are incremented before they are returned. */
1291 static const fnode
*
1292 next_format0 (fnode
* f
)
1299 if (f
->format
!= FMT_LPAREN
)
1302 if (f
->count
<= f
->repeat
)
1309 /* Deal with a parenthesis node with unlimited format. */
1311 if (f
->repeat
== -2) /* -2 signifies unlimited. */
1314 if (f
->current
== NULL
)
1315 f
->current
= f
->u
.child
;
1317 for (; f
->current
!= NULL
; f
->current
= f
->current
->next
)
1319 r
= next_format0 (f
->current
);
1325 /* Deal with a parenthesis node with specific repeat count. */
1326 for (; f
->count
< f
->repeat
; f
->count
++)
1328 if (f
->current
== NULL
)
1329 f
->current
= f
->u
.child
;
1331 for (; f
->current
!= NULL
; f
->current
= f
->current
->next
)
1333 r
= next_format0 (f
->current
);
1344 /* next_format()-- Return the next format node. If the format list
1345 * ends up being exhausted, we do reversion. Reversion is only
1346 * allowed if we've seen a data descriptor since the
1347 * initialization or the last reversion. We return NULL if there
1348 * are no more data descriptors to return (which is an error
1352 next_format (st_parameter_dt
*dtp
)
1356 format_data
*fmt
= dtp
->u
.p
.fmt
;
1358 if (fmt
->saved_format
!= NULL
)
1359 { /* Deal with a pushed-back format node */
1360 f
= fmt
->saved_format
;
1361 fmt
->saved_format
= NULL
;
1365 f
= next_format0 (&fmt
->array
.array
[0]);
1368 if (!fmt
->reversion_ok
)
1371 fmt
->reversion_ok
= 0;
1374 f
= next_format0 (&fmt
->array
.array
[0]);
1377 format_error (dtp
, NULL
, reversion_error
);
1381 /* Push the first reverted token and return a colon node in case
1382 * there are no more data items. */
1384 fmt
->saved_format
= f
;
1388 /* If this is a data edit descriptor, then reversion has become OK. */
1392 if (!fmt
->reversion_ok
&&
1393 (t
== FMT_I
|| t
== FMT_B
|| t
== FMT_O
|| t
== FMT_Z
|| t
== FMT_F
||
1394 t
== FMT_E
|| t
== FMT_EN
|| t
== FMT_ES
|| t
== FMT_G
|| t
== FMT_L
||
1395 t
== FMT_A
|| t
== FMT_D
))
1396 fmt
->reversion_ok
= 1;
1401 /* unget_format()-- Push the given format back so that it will be
1402 * returned on the next call to next_format() without affecting
1403 * counts. This is necessary when we've encountered a data
1404 * descriptor, but don't know what the data item is yet. The format
1405 * node is pushed back, and we return control to the main program,
1406 * which calls the library back with the data item (or not). */
1409 unget_format (st_parameter_dt
*dtp
, const fnode
*f
)
1411 dtp
->u
.p
.fmt
->saved_format
= f
;