diff options
author | Diego Novillo <dnovillo@gcc.gnu.org> | 2004-05-13 02:41:07 -0400 |
---|---|---|
committer | Diego Novillo <dnovillo@gcc.gnu.org> | 2004-05-13 02:41:07 -0400 |
commit | 6de9cd9a886ea695aa892c3c7c07818a7b7e9e6f (patch) | |
tree | a2568888a519c077427b133de9ece5879a8484a5 /libgfortran/io/format.c | |
parent | ac1a20aec53364d77f3bdff94a2a0a06840e0fe9 (diff) | |
download | gcc-6de9cd9a886ea695aa892c3c7c07818a7b7e9e6f.zip gcc-6de9cd9a886ea695aa892c3c7c07818a7b7e9e6f.tar.gz gcc-6de9cd9a886ea695aa892c3c7c07818a7b7e9e6f.tar.bz2 |
Merge tree-ssa-20020619-branch into mainline.
From-SVN: r81764
Diffstat (limited to 'libgfortran/io/format.c')
-rw-r--r-- | libgfortran/io/format.c | 1285 |
1 files changed, 1285 insertions, 0 deletions
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c new file mode 100644 index 0000000..caec167 --- /dev/null +++ b/libgfortran/io/format.c @@ -0,0 +1,1285 @@ +/* Copyright (C) 2002-2003 Free Software Foundation, Inc. + Contributed by Andy Vaught + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with Libgfortran; see the file COPYING. If not, write to +the Free Software Foundation, 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + + +/* format.c-- parse a FORMAT string into a binary format suitable for + * interpretation during I/O statements */ + +#include "config.h" +#include <ctype.h> +#include <string.h> +#include "libgfortran.h" +#include "io.h" + + + +/* Number of format nodes that we can store statically before we have + * to resort to dynamic allocation. The root node is array[0]. */ + +#define FARRAY_SIZE 200 + +static fnode *avail, array[FARRAY_SIZE]; + +/* Local variables for checking format strings. The saved_token is + * used to back up by a single format token during the parsing process. */ + +static char *format_string, *string; +static const char *error; +static format_token saved_token; +static int value, format_string_len, reversion_ok; + +static fnode *saved_format, colon_node = { FMT_COLON }; + +/* Error messages */ + +static char posint_required[] = "Positive width required in format", + period_required[] = "Period required in format", + nonneg_required[] = "Nonnegative width required in format", + unexpected_element[] = "Unexpected element in format", + unexpected_end[] = "Unexpected end of format string", + bad_string[] = "Unterminated character constant in format", + bad_hollerith[] = "Hollerith constant extends past the end of the format", + reversion_error[] = "Exhausted data descriptors in format"; + + +/* next_char()-- Return the next character in the format string. + * Returns -1 when the string is done. If the literal flag is set, + * spaces are significant, otherwise they are not. */ + +static int +next_char (int literal) +{ + int c; + + do + { + if (format_string_len == 0) + return -1; + + format_string_len--; + c = toupper (*format_string++); + } + while (c == ' ' && !literal); + + return c; +} + + +/* unget_char()-- Back up one character position. */ + +#define unget_char() { format_string--; format_string_len++; } + + +/* get_fnode()-- Allocate a new format node, inserting it into the + * current singly linked list. These are initially allocated from the + * static buffer. */ + +static fnode * +get_fnode (fnode ** head, fnode ** tail, format_token t) +{ + fnode *f; + + if (avail - array >= FARRAY_SIZE) + f = get_mem (sizeof (fnode)); + else + { + f = avail++; + memset (f, '\0', sizeof (fnode)); + } + + if (*head == NULL) + *head = *tail = f; + else + { + (*tail)->next = f; + *tail = f; + } + + f->format = t; + f->repeat = -1; + f->source = format_string; + return f; +} + + +/* free_fnode()-- Recursive function to free the given fnode and + * everything it points to. We only have to actually free something + * if it is outside of the static array. */ + +static void +free_fnode (fnode * f) +{ + fnode *next; + + for (; f; f = next) + { + next = f->next; + + if (f->format == FMT_LPAREN) + free_fnode (f->u.child); + if (f < array || f >= array + FARRAY_SIZE) + free_mem (f); + } +} + + +/* free_fnodes()-- Free the current tree of fnodes. We only have to + * traverse the tree if some nodes were allocated dynamically. */ + +void +free_fnodes (void) +{ + + if (avail - array >= FARRAY_SIZE) + free_fnode (&array[0]); + + avail = array; + memset(array, 0, sizeof(avail[0]) * FARRAY_SIZE); +} + + +/* format_lex()-- Simple lexical analyzer for getting the next token + * in a FORMAT string. We support a one-level token pushback in the + * saved_token variable. */ + +static format_token +format_lex (void) +{ + format_token token; + int negative_flag; + char c, delim; + + if (saved_token != FMT_NONE) + { + token = saved_token; + saved_token = FMT_NONE; + return token; + } + + negative_flag = 0; + c = next_char (0); + + switch (c) + { + case '-': + negative_flag = 1; + /* Fall Through */ + + case '+': + c = next_char (0); + if (!isdigit (c)) + { + token = FMT_UNKNOWN; + break; + } + + value = c - '0'; + + for (;;) + { + c = next_char (0); + if (!isdigit (c)) + break; + + value = 10 * value + c - '0'; + } + + unget_char (); + + if (negative_flag) + value = -value; + token = FMT_SIGNED_INT; + break; + + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + value = c - '0'; + + for (;;) + { + c = next_char (0); + if (!isdigit (c)) + break; + + value = 10 * value + c - '0'; + } + + unget_char (); + token = (value == 0) ? FMT_ZERO : FMT_POSINT; + break; + + case '.': + token = FMT_PERIOD; + break; + + case ',': + token = FMT_COMMA; + break; + + case ':': + token = FMT_COLON; + break; + + case '/': + token = FMT_SLASH; + break; + + case '$': + token = FMT_DOLLAR; + break; + + case 'T': + switch (next_char (0)) + { + case 'L': + token = FMT_TL; + break; + case 'R': + token = FMT_TR; + break; + default: + token = FMT_T; + unget_char (); + break; + } + + break; + + case '(': + token = FMT_LPAREN; + break; + + case ')': + token = FMT_RPAREN; + break; + + case 'X': + token = FMT_X; + break; + + case 'S': + switch (next_char (0)) + { + case 'S': + token = FMT_SS; + break; + case 'P': + token = FMT_SP; + break; + default: + token = FMT_S; + unget_char (); + break; + } + + break; + + case 'B': + switch (next_char (0)) + { + case 'N': + token = FMT_BN; + break; + case 'Z': + token = FMT_BZ; + break; + default: + token = FMT_B; + unget_char (); + break; + } + + break; + + case '\'': + case '"': + delim = c; + + string = format_string; + value = 0; /* This is the length of the string */ + + for (;;) + { + c = next_char (1); + if (c == -1) + { + token = FMT_BADSTRING; + error = bad_string; + break; + } + + if (c == delim) + { + c = next_char (1); + + if (c == -1) + { + token = FMT_BADSTRING; + error = bad_string; + break; + } + + if (c != delim) + { + unget_char (); + token = FMT_STRING; + break; + } + } + + value++; + } + + break; + + case 'P': + token = FMT_P; + break; + + case 'I': + token = FMT_I; + break; + + case 'O': + token = FMT_O; + break; + + case 'Z': + token = FMT_Z; + break; + + case 'F': + token = FMT_F; + break; + + case 'E': + switch (next_char (0)) + { + case 'N': + token = FMT_EN; + break; + case 'S': + token = FMT_ES; + break; + default: + token = FMT_E; + unget_char (); + break; + } + + break; + + case 'G': + token = FMT_G; + break; + + case 'H': + token = FMT_H; + break; + + case 'L': + token = FMT_L; + break; + + case 'A': + token = FMT_A; + break; + + case 'D': + token = FMT_D; + break; + + case -1: + token = FMT_END; + break; + + default: + token = FMT_UNKNOWN; + break; + } + + return token; +} + + +/* parse_format_list()-- Parse a format list. Assumes that a left + * paren has already been seen. Returns a list representing the + * parenthesis node which contains the rest of the list. */ + +static fnode * +parse_format_list (void) +{ + fnode *head, *tail; + format_token t, u, t2; + int repeat; + + head = tail = NULL; + +/* Get the next format item */ + +format_item: + t = format_lex (); + switch (t) + { + case FMT_POSINT: + repeat = value; + + t = format_lex (); + switch (t) + { + case FMT_LPAREN: + get_fnode (&head, &tail, FMT_LPAREN); + tail->repeat = repeat; + tail->u.child = parse_format_list (); + if (error != NULL) + goto finished; + + goto between_desc; + + case FMT_SLASH: + get_fnode (&head, &tail, FMT_SLASH); + tail->repeat = repeat; + goto optional_comma; + + case FMT_X: + get_fnode (&head, &tail, FMT_X); + tail->repeat = 1; + tail->u.k = value; + goto between_desc; + + case FMT_P: + goto p_descriptor; + + default: + goto data_desc; + } + + case FMT_LPAREN: + get_fnode (&head, &tail, FMT_LPAREN); + tail->repeat = 1; + tail->u.child = parse_format_list (); + if (error != NULL) + goto finished; + + goto between_desc; + + case FMT_SIGNED_INT: /* Signed integer can only precede a P format. */ + case FMT_ZERO: /* Same for zero. */ + t = format_lex (); + if (t != FMT_P) + { + error = "Expected P edit descriptor in format"; + goto finished; + } + + p_descriptor: + get_fnode (&head, &tail, FMT_P); + tail->u.k = value; + + t = format_lex (); + if (t == FMT_F || t == FMT_EN || t == FMT_ES || t == FMT_D + || t == FMT_G || t == FMT_E) + { + repeat = 1; + goto data_desc; + } + + saved_token = t; + goto between_desc; + + case FMT_P: /* P and X require a prior number */ + error = "P descriptor requires leading scale factor"; + goto finished; + + case FMT_X: +/* + EXTENSION! + + If we would be pedantic in the library, we would have to reject + an X descriptor without an integer prefix: + + error = "X descriptor requires leading space count"; + goto finished; + + However, this is an extension supported by many Fortran compilers, + including Cray, HP, AIX, and IRIX. Therefore, we allow it in the + runtime library, and make the front end reject it if the compiler + is in pedantic mode. The interpretation of 'X' is '1X'. +*/ + get_fnode (&head, &tail, FMT_X); + tail->repeat = 1; + tail->u.k = 1; + goto between_desc; + + case FMT_STRING: + get_fnode (&head, &tail, FMT_STRING); + + tail->u.string.p = string; + tail->u.string.length = value; + tail->repeat = 1; + goto between_desc; + + case FMT_S: + case FMT_SS: + case FMT_SP: + case FMT_BN: + case FMT_BZ: + get_fnode (&head, &tail, t); + goto between_desc; + + case FMT_COLON: + get_fnode (&head, &tail, FMT_COLON); + goto optional_comma; + + case FMT_SLASH: + get_fnode (&head, &tail, FMT_SLASH); + tail->repeat = 1; + tail->u.r = 1; + goto optional_comma; + + case FMT_DOLLAR: + get_fnode (&head, &tail, FMT_DOLLAR); + goto between_desc; + + case FMT_T: + case FMT_TL: + case FMT_TR: + t2 = format_lex (); + if (t2 != FMT_POSINT) + { + error = posint_required; + goto finished; + } + get_fnode (&head, &tail, t); + tail->u.n = value; + tail->repeat = 1; + goto between_desc; + + case FMT_I: + case FMT_B: + case FMT_O: + case FMT_Z: + case FMT_E: + case FMT_EN: + case FMT_ES: + case FMT_D: + case FMT_L: + case FMT_A: + case FMT_F: + case FMT_G: + repeat = 1; + goto data_desc; + + case FMT_H: + get_fnode (&head, &tail, FMT_STRING); + + if (format_string_len < 1) + { + error = bad_hollerith; + goto finished; + } + + tail->u.string.p = format_string; + tail->u.string.length = 1; + tail->repeat = 1; + + format_string++; + format_string_len--; + + goto between_desc; + + case FMT_END: + error = unexpected_end; + goto finished; + + case FMT_BADSTRING: + goto finished; + + case FMT_RPAREN: + goto finished; + + default: + error = unexpected_element; + goto finished; + } + +/* In this state, t must currently be a data descriptor. Deal with + * things that can/must follow the descriptor */ + +data_desc: + switch (t) + { + case FMT_P: + t = format_lex (); + if (t == FMT_POSINT) + { + error = "Repeat count cannot follow P descriptor"; + goto finished; + } + + saved_token = t; + get_fnode (&head, &tail, FMT_P); + + goto optional_comma; + + case FMT_L: + t = format_lex (); + if (t != FMT_POSINT) + { + error = posint_required; + goto finished; + } + + get_fnode (&head, &tail, FMT_L); + tail->u.n = value; + tail->repeat = repeat; + break; + + case FMT_A: + t = format_lex (); + if (t != FMT_POSINT) + { + saved_token = t; + value = -1; /* Width not present */ + } + + get_fnode (&head, &tail, FMT_A); + tail->repeat = repeat; + tail->u.n = value; + break; + + case FMT_D: + case FMT_E: + case FMT_F: + case FMT_G: + case FMT_EN: + case FMT_ES: + get_fnode (&head, &tail, t); + tail->repeat = repeat; + + u = format_lex (); + if (t == FMT_F || g.mode == WRITING) + { + if (u != FMT_POSINT && u != FMT_ZERO) + { + error = nonneg_required; + goto finished; + } + } + else + { + if (u != FMT_POSINT) + { + error = posint_required; + goto finished; + } + } + + tail->u.real.w = value; + t2 = t; + t = format_lex (); + if (t != FMT_PERIOD) + { + error = period_required; + goto finished; + } + + t = format_lex (); + if (t != FMT_ZERO && t != FMT_POSINT) + { + error = nonneg_required; + goto finished; + } + + tail->u.real.d = value; + + if (t == FMT_D || t == FMT_F) + break; + + tail->u.real.e = -1; + +/* Look for optional exponent */ + + t = format_lex (); + if (t != FMT_E) + saved_token = t; + else + { + t = format_lex (); + if (t != FMT_POSINT) + { + error = "Positive exponent width required in format"; + goto finished; + } + + tail->u.real.e = value; + } + + break; + + case FMT_H: + if (repeat > format_string_len) + { + error = bad_hollerith; + goto finished; + } + + get_fnode (&head, &tail, FMT_STRING); + + tail->u.string.p = format_string; + tail->u.string.length = repeat; + tail->repeat = 1; + + format_string += value; + format_string_len -= repeat; + + break; + + case FMT_I: + case FMT_B: + case FMT_O: + case FMT_Z: + get_fnode (&head, &tail, t); + tail->repeat = repeat; + + t = format_lex (); + + if (g.mode == READING) + { + if (t != FMT_POSINT) + { + error = posint_required; + goto finished; + } + } + else + { + if (t != FMT_ZERO && t != FMT_POSINT) + { + error = nonneg_required; + goto finished; + } + } + + tail->u.integer.w = value; + tail->u.integer.m = -1; + + t = format_lex (); + if (t != FMT_PERIOD) + { + saved_token = t; + } + else + { + t = format_lex (); + if (t != FMT_ZERO && t != FMT_POSINT) + { + error = nonneg_required; + goto finished; + } + + tail->u.integer.m = value; + } + + if (tail->u.integer.w != 0 && tail->u.integer.m > tail->u.integer.w) + { + error = "Minimum digits exceeds field width"; + goto finished; + } + + break; + + default: + error = unexpected_element; + goto finished; + } + +/* Between a descriptor and what comes next */ +between_desc: + t = format_lex (); + switch (t) + { + case FMT_COMMA: + goto format_item; + + case FMT_RPAREN: + goto finished; + + case FMT_SLASH: + get_fnode (&head, &tail, FMT_SLASH); + tail->repeat = 1; + + /* Fall Through */ + + case FMT_COLON: + goto optional_comma; + + case FMT_END: + error = unexpected_end; + goto finished; + + default: + error = "Missing comma in format"; + goto finished; + } + +/* Optional comma is a weird between state where we've just finished + * reading a colon, slash or P descriptor. */ + +optional_comma: + t = format_lex (); + switch (t) + { + case FMT_COMMA: + break; + + case FMT_RPAREN: + goto finished; + + default: /* Assume that we have another format item */ + saved_token = t; + break; + } + + goto format_item; + +finished: + return head; +} + + +/* format_error()-- Generate an error message for a format statement. + * If the node that gives the location of the error is NULL, the error + * is assumed to happen at parse time, and the current location of the + * parser is shown. + * + * After freeing any dynamically allocated fnodes, generate a message + * showing where the problem is. We take extra care to print only the + * relevant part of the format if it is longer than a standard 80 + * column display. */ + +void +format_error (fnode * f, const char *message) +{ + int width, i, j, offset; + char *p, buffer[300]; + + if (f != NULL) + format_string = f->source; + + free_fnodes (); + + st_sprintf (buffer, "%s\n", message); + + j = format_string - ioparm.format; + + offset = (j > 60) ? j - 40 : 0; + + j -= offset; + width = ioparm.format_len - offset; + + if (width > 80) + width = 80; + + /* Show the format */ + + p = strchr (buffer, '\0'); + + memcpy (p, ioparm.format + offset, width); + + p += width; + *p++ = '\n'; + + /* Show where the problem is */ + + for (i = 1; i < j; i++) + *p++ = ' '; + + *p++ = '^'; + *p = '\0'; + + generate_error (ERROR_FORMAT, buffer); +} + + +/* parse_format()-- Parse a format string. */ + +void +parse_format (void) +{ + + format_string = ioparm.format; + format_string_len = ioparm.format_len; + + saved_token = FMT_NONE; + error = NULL; + +/* Initialize variables used during traversal of the tree */ + + reversion_ok = 0; + g.reversion_flag = 0; + saved_format = NULL; + +/* Allocate the first format node as the root of the tree */ + + avail = array; + + avail->format = FMT_LPAREN; + avail->repeat = 1; + avail++; + + if (format_lex () == FMT_LPAREN) + array[0].u.child = parse_format_list (); + else + error = "Missing initial left parenthesis in format"; + + if (error) + format_error (NULL, error); +} + + +/* revert()-- Do reversion of the format. Control reverts to the left + * parenthesis that matches the rightmost right parenthesis. From our + * tree structure, we are looking for the rightmost parenthesis node + * at the second level, the first level always being a single + * parenthesis node. If this node doesn't exit, we use the top + * level. */ + +static void +revert (void) +{ + fnode *f, *r; + + g.reversion_flag = 1; + + r = NULL; + + for (f = array[0].u.child; f; f = f->next) + if (f->format == FMT_LPAREN) + r = f; + + /* If r is NULL because no node was found, the whole tree will be used */ + + array[0].current = r; + array[0].count = 0; +} + + +/* next_format0()-- Get the next format node without worrying about + * reversion. Returns NULL when we hit the end of the list. + * Parenthesis nodes are incremented after the list has been + * exhausted, other nodes are incremented before they are returned. */ + +static fnode * +next_format0 (fnode * f) +{ + fnode *r; + + if (f == NULL) + return NULL; + + if (f->format != FMT_LPAREN) + { + f->count++; + if (f->count <= f->repeat) + return f; + + f->count = 0; + return NULL; + } + + /* Deal with a parenthesis node */ + + for (; f->count < f->repeat; f->count++) + { + if (f->current == NULL) + f->current = f->u.child; + + for (; f->current != NULL; f->current = f->current->next) + { + r = next_format0 (f->current); + if (r != NULL) + return r; + } + } + + f->count = 0; + return NULL; +} + + +/* next_format()-- Return the next format node. If the format list + * ends up being exhausted, we do reversion. Reversion is only + * allowed if the we've seen a data descriptor since the + * initialization or the last reversion. We return NULL if the there + * are no more data descriptors to return (which is an error + * condition). */ + +fnode * +next_format (void) +{ + format_token t; + fnode *f; + + if (saved_format != NULL) + { /* Deal with a pushed-back format node */ + f = saved_format; + saved_format = NULL; + goto done; + } + + f = next_format0 (&array[0]); + if (f == NULL) + { + if (!reversion_ok) + { + return NULL; + } + + reversion_ok = 0; + revert (); + + f = next_format0 (&array[0]); + if (f == NULL) + { + format_error (NULL, reversion_error); + return NULL; + } + + /* Push the first reverted token and return a colon node in case + * there are no more data items. */ + + saved_format = f; + return &colon_node; + } + + /* If this is a data edit descriptor, then reversion has become OK. */ + +done: + t = f->format; + + if (!reversion_ok && + (t == FMT_I || t == FMT_B || t == FMT_O || t == FMT_Z || t == FMT_F || + t == FMT_E || t == FMT_EN || t == FMT_ES || t == FMT_G || t == FMT_L || + t == FMT_A || t == FMT_D)) + reversion_ok = 1; + return f; +} + + +/* unget_format()-- Push the given format back so that it will be + * returned on the next call to next_format() without affecting + * counts. This is necessary when we've encountered a data + * descriptor, but don't know what the data item is yet. The format + * node is pushed back, and we return control to the main program, + * which calls the library back with the data item (or not). */ + +void +unget_format (fnode * f) +{ + + saved_format = f; +} + + + + +#if 0 + +static void dump_format1 (fnode * f); + +/* dump_format0()-- Dump a single format node */ + +void +dump_format0 (fnode * f) +{ + char *p; + int i; + + switch (f->format) + { + case FMT_COLON: + st_printf (" :"); + break; + case FMT_SLASH: + st_printf (" %d/", f->u.r); + break; + case FMT_DOLLAR: + st_printf (" $"); + break; + case FMT_T: + st_printf (" T%d", f->u.n); + break; + case FMT_TR: + st_printf (" TR%d", f->u.n); + break; + case FMT_TL: + st_printf (" TL%d", f->u.n); + break; + case FMT_X: + st_printf (" %dX", f->u.n); + break; + case FMT_S: + st_printf (" S"); + break; + case FMT_SS: + st_printf (" SS"); + break; + case FMT_SP: + st_printf (" SP"); + break; + + case FMT_LPAREN: + if (f->repeat == 1) + st_printf (" ("); + else + st_printf (" %d(", f->repeat); + + dump_format1 (f->u.child); + st_printf (" )"); + break; + + case FMT_STRING: + st_printf (" '"); + p = f->u.string.p; + for (i = f->u.string.length; i > 0; i--) + st_printf ("%c", *p++); + + st_printf ("'"); + break; + + case FMT_P: + st_printf (" %dP", f->u.k); + break; + case FMT_I: + st_printf (" %dI%d.%d", f->repeat, f->u.integer.w, f->u.integer.m); + break; + + case FMT_B: + st_printf (" %dB%d.%d", f->repeat, f->u.integer.w, f->u.integer.m); + break; + + case FMT_O: + st_printf (" %dO%d.%d", f->repeat, f->u.integer.w, f->u.integer.m); + break; + + case FMT_Z: + st_printf (" %dZ%d.%d", f->repeat, f->u.integer.w, f->u.integer.m); + break; + + case FMT_BN: + st_printf (" BN"); + break; + case FMT_BZ: + st_printf (" BZ"); + break; + case FMT_D: + st_printf (" %dD%d.%d", f->repeat, f->u.real.w, f->u.real.d); + break; + + case FMT_EN: + st_printf (" %dEN%d.%dE%d", f->repeat, f->u.real.w, f->u.real.d, + f->u.real.e); + break; + + case FMT_ES: + st_printf (" %dES%d.%dE%d", f->repeat, f->u.real.w, f->u.real.d, + f->u.real.e); + break; + + case FMT_F: + st_printf (" %dF%d.%d", f->repeat, f->u.real.w, f->u.real.d); + break; + + case FMT_E: + st_printf (" %dE%d.%dE%d", f->repeat, f->u.real.w, f->u.real.d, + f->u.real.e); + break; + + case FMT_G: + st_printf (" %dG%d.%dE%d", f->repeat, f->u.real.w, f->u.real.d, + f->u.real.e); + break; + + case FMT_L: + st_printf (" %dL%d", f->repeat, f->u.w); + break; + case FMT_A: + st_printf (" %dA%d", f->repeat, f->u.w); + break; + + default: + st_printf (" ???"); + break; + } +} + + +/* dump_format1()-- Dump a string of format nodes */ + +static void +dump_format1 (fnode * f) +{ + + for (; f; f = f->next) + dump_format1 (f); +} + +/* dump_format()-- Dump the whole format node tree */ + +void +dump_format (void) +{ + + st_printf ("format = "); + dump_format0 (&array[0]); + st_printf ("\n"); +} + + +void +next_test (void) +{ + fnode *f; + int i; + + for (i = 0; i < 20; i++) + { + f = next_format (); + if (f == NULL) + { + st_printf ("No format!\n"); + break; + } + + dump_format1 (f); + st_printf ("\n"); + } +} + +#endif |