/*
 * Copyright (c) 2002-2004, The Tendra Project <http://www.ten15.org/>
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice unmodified, this list of conditions, and the following
 *    disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
 * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 *
 *    		 Crown Copyright (c) 1997
 *
 *    This TenDRA(r) Computer Program is subject to Copyright
 *    owned by the United Kingdom Secretary of State for Defence
 *    acting through the Defence Evaluation and Research Agency
 *    (DERA).  It is made available to Recipients with a
 *    royalty-free licence for its use, reproduction, transfer
 *    to other parties and amendment for any purpose not excluding
 *    product development provided that any such use et cetera
 *    shall be deemed to be acceptance of the following conditions:-
 *
 *        (1) Its Recipients shall ensure that this Notice is
 *        reproduced upon any copies or amended versions of it;
 *
 *        (2) Any amended version of it shall be clearly marked to
 *        show both the nature of and the organisation responsible
 *        for the relevant amendment or amendments;
 *
 *        (3) Its onward transfer from a recipient to another
 *        party shall be deemed to be that party's acceptance of
 *        these conditions;
 *
 *        (4) DERA gives no warranty or assurance as to its
 *        quality or suitability for any purpose and DERA accepts
 *        no liability whatsoever in relation to any use to which
 *        it may be put.
 *
 * $TenDRA: tendra/src/tools/disp/templ/tdf.c-tdf,v 1.5 2004/09/05 03:47:05 bp Exp $
 */


/* AUTOMATICALLY GENERATED BY make_tdf VERSION 2.0 FROM TDF 4.1 */

#include "config.h"
#include "msgcat.h"
#include "tdf_types.h"
#include "tdf_stream.h"

#include "types.h"
#include "basic.h"
#include "binding.h"
#include "file.h"
#include "sort.h"
#include "tdf.h"
#include "tree.h"
#include "unit.h"


/* DECODE A ACCESS */

long
de_access(void)
{
    long n = tdf_de_tdfextint (tdfr, 4);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_access, "access");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "access_cond", "x@[u]@[u]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "add_accesses", "uu");
	    break;
	}
	case 4 : {
	    out ("constant");
	    break;
	}
	case 5 : {
	    out ("long_jump_access");
	    break;
	}
	case 6 : {
	    out ("no_other_read");
	    break;
	}
	case 7 : {
	    out ("no_other_write");
	    break;
	}
	case 8 : {
	    out ("out_par");
	    break;
	}
	case 9 : {
	    out ("preserve");
	    break;
	}
	case 10 : {
	    out ("register");
	    break;
	}
	case 11 : {
	    out ("standard_access");
	    break;
	}
	case 12 : {
	    out ("used_as_volatile");
	    break;
	}
	case 13 : {
	    out ("visible");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("ACCESS", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A AL_TAG */

long
de_al_tag(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    switch (n) {
	case 2 : {
	    IGNORE de_token_aux (sort_al_tag, "al_tag");
	    break;
	}
	case 1 : {
	    long t = tdf_int ();
	    out_object (t, (object *) null, var_al_tag);
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("AL_TAG", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A AL_TAGDEF */

long
de_al_tagdef(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    if (n < 1 || n > 1) {
	out ("<error>");
	MSG_illegal_st_value("AL_TAGDEF", n);
	n = -1;
    }
    return (n);
}


/* DECODE A ALIGNMENT */

long
de_alignment(void)
{
    long n = tdf_de_tdfextint (tdfr, 4);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_alignment, "alignment");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "alignment_cond", "x@[a]@[a]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "alignment", "S");
	    break;
	}
	case 4 : {
	    out ("alloca_alignment");
	    break;
	}
	case 5 : {
	    format (VERT_BRACKETS, "callees_alignment", "b");
	    break;
	}
	case 6 : {
	    format (VERT_BRACKETS, "callers_alignment", "b");
	    break;
	}
	case 7 : {
	    out ("code_alignment");
	    break;
	}
	case 8 : {
	    out ("locals_alignment");
	    break;
	}
	case 9 : {
	    format (VERT_BRACKETS, "obtain_al_tag", "A");
	    break;
	}
	case 10 : {
	    format (VERT_BRACKETS, "parameter_alignment", "S");
	    break;
	}
	case 11 : {
	    format (VERT_BRACKETS, "unite_alignments", "aa");
	    break;
	}
	case 12 : {
	    out ("var_param_alignment");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("ALIGNMENT", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A BITFIELD_VARIETY */

long
de_bitfield_variety(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_bitfield_variety, "bitfield_variety");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "bfvar_cond", "x@[B]@[B]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "bfvar_bits", "bn");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("BITFIELD_VARIETY", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A BOOL */

long
de_bool(void)
{
    long n = tdf_de_tdfextint (tdfr, 3);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_bool, "bool");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "bool_cond", "x@[b]@[b]");
	    break;
	}
	case 3 : {
	    out ("false");
	    break;
	}
	case 4 : {
	    out ("true");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("BOOL", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A CALLEES */

long
de_callees(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "make_callee_list", "*[x]");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "make_dynamic_callees", "xx");
	    break;
	}
	case 3 : {
	    out ("same_callees");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("CALLEES", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG */

long
de_dg(void)
{
    long n = tdf_de_tdfextint (tdfr, 6);
    switch (n) {
	case 1 : {
	    sortname sn = find_sortname ('G');
	    IGNORE de_token_aux (sn, "dg");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "make_tag_dg", "JG");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "abortable_part_dg", "Wb");
	    break;
	}
	case 4 : {
	    format (VERT_BRACKETS, "accept_dg", "WJ*[h]b?[J]");
	    break;
	}
	case 5 : {
	    format (VERT_BRACKETS, "barrier_dg", "WJ");
	    break;
	}
	case 6 : {
	    format (VERT_BRACKETS, "branch_dg", "W");
	    break;
	}
	case 7 : {
	    format (VERT_BRACKETS, "call_dg", "?[Y]W?[n]?[J]?[J]");
	    break;
	}
	case 8 : {
	    format (VERT_BRACKETS, "compilation_dg", "J");
	    break;
	}
	case 9 : {
	    format (VERT_BRACKETS, "destructor_dg", "W?[x]");
	    break;
	}
	case 10 : {
	    format (VERT_BRACKETS, "exception_handler_dg", "?[h]");
	    break;
	}
	case 11 : {
	    format (VERT_BRACKETS, "exception_scope_dg", "*[J]");
	    break;
	}
	case 12 : {
	    format (VERT_BRACKETS, "inline_call_dg", "J*[h]?[n]");
	    break;
	}
	case 13 : {
	    format (VERT_BRACKETS, "inline_result_dg", "J");
	    break;
	}
	case 14 : {
	    format (VERT_BRACKETS, "inlined_dg", "GJ");
	    break;
	}
	case 15 : {
	    format (VERT_BRACKETS, "jump_dg", "W");
	    break;
	}
	case 16 : {
	    format (VERT_BRACKETS, "label_dg", "YW");
	    break;
	}
	case 17 : {
	    format (VERT_BRACKETS, "lexical_block_dg", "?[Y]W");
	    break;
	}
	case 18 : {
	    format (VERT_BRACKETS, "list_dg", "*[G]");
	    break;
	}
	case 19 : {
	    format (VERT_BRACKETS, "long_jump_dg", "W");
	    break;
	}
	case 20 : {
	    format (VERT_BRACKETS, "name_decl_dg", "h");
	    break;
	}
	case 21 : {
	    format (VERT_BRACKETS, "params_dg", "*[h]?[x]");
	    break;
	}
	case 22 : {
	    format (VERT_BRACKETS, "raise_dg", "W?[\015]?[x]");
	    break;
	}
	case 23 : {
	    format (VERT_BRACKETS, "requeue_dg", "WJb");
	    break;
	}
	case 24 : {
	    format (VERT_BRACKETS, "rts_call_dg", "Wn?[J]?[J]");
	    break;
	}
	case 25 : {
	    format (VERT_BRACKETS, "select_dg", "Wb");
	    break;
	}
	case 26 : {
	    format (VERT_BRACKETS, "select_alternative_dg", "Wnbx");
	    break;
	}
	case 27 : {
	    format (VERT_BRACKETS, "select_guard_dg", "WJ");
	    break;
	}
	case 28 : {
	    format (VERT_BRACKETS, "singlestep_dg", "W");
	    break;
	}
	case 29 : {
	    format (VERT_BRACKETS, "source_language_dg", "n");
	    break;
	}
	case 30 : {
	    format (VERT_BRACKETS, "sourcepos_dg", "W");
	    break;
	}
	case 31 : {
	    format (VERT_BRACKETS, "statement_part_dg", "J");
	    break;
	}
	case 32 : {
	    format (VERT_BRACKETS, "test_dg", "Wb");
	    break;
	}
	case 33 : {
	    format (VERT_BRACKETS, "triggering_alternative_dg", "Wnb");
	    break;
	}
	case 34 : {
	    format (VERT_BRACKETS, "with_dg", "\015x");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_ACCESSIBILITY */

long
de_dg_accessibility(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    out ("dg_local_accessibility");
	    break;
	}
	case 2 : {
	    out ("dg_private_accessibility");
	    break;
	}
	case 3 : {
	    out ("dg_protected_accessibility");
	    break;
	}
	case 4 : {
	    out ("dg_public_accessibility");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_ACCESSIBILITY", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_APPEND */

long
de_dg_append(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "dg_name_append", "Jh");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_APPEND", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_BOUND */

long
de_dg_bound(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "dg_dynamic_bound", "JS");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "dg_static_bound", "x");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "dg_unknown_bound", "S");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_BOUND", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_CLASS_BASE */

long
de_dg_class_base(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "make_dg_class_base", "J?[W]?[T]?[o]?[\020]");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_CLASS_BASE", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_CLASSMEM */

long
de_dg_classmem(void)
{
    long n = tdf_de_tdfextint (tdfr, 3);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "dg_tag_classmem", "Jz");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "dg_field_classmem", "YWx\015?[o]?[b]?[\012]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "dg_function_classmem", "h?[x]");
	    break;
	}
	case 4 : {
	    format (VERT_BRACKETS, "dg_indirect_classmem", "YWT\015");
	    break;
	}
	case 5 : {
	    format (VERT_BRACKETS, "dg_name_classmem", "h");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_CLASSMEM", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_COMPILATION */

long
de_dg_compilation(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "dg_tag_compilation", "JC");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "make_dg_compilation", "U*[X]*[Z]UnnnX*[X]k");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_COMPILATION", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_CONSTRAINT */

long
de_dg_constraint(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "dg_type_constraint", "?[J]\015");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "dg_value_constraint", "?[J]x");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_CONSTRAINT", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_DEFAULT */

long
de_dg_default(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "make_dg_default", "?[x]?[W]");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_DEFAULT", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_DIM */

long
de_dg_dim(void)
{
    long n = tdf_de_tdfextint (tdfr, 3);
    switch (n) {
	case 1 : {
	    sortname sn = find_sortname ('O');
	    IGNORE de_token_aux (sn, "dg_dim");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "dg_tag_dim", "JO");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "dg_bounds_dim", "ww\015");
	    break;
	}
	case 4 : {
	    format (VERT_BRACKETS, "dg_count_dim", "ww\015");
	    break;
	}
	case 5 : {
	    format (VERT_BRACKETS, "dg_type_dim", "\015?[n]");
	    break;
	}
	case 6 : {
	    out ("dg_unspecified_dim");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_DIM", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_DISCRIM */

long
de_dg_discrim(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "make_dg_discrim", "xx");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_DISCRIM", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_ENUM */

long
de_dg_enum(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "dg_tag_enum", "JE");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "make_dg_enum", "xYW");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "dg_char_enum", "xnW");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_ENUM", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_FILENAME */

long
de_dg_filename(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    sortname sn = find_sortname ('U');
	    IGNORE de_token_aux (sn, "dg_filename");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "make_dg_filename", "nXXX");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_FILENAME", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_IDNAME */

long
de_dg_idname(void)
{
    long n = tdf_de_tdfextint (tdfr, 3);
    switch (n) {
	case 1 : {
	    sortname sn = find_sortname ('Y');
	    IGNORE de_token_aux (sn, "dg_idname");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "dg_anonymous_idname", "?[X]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "dg_artificial_idname", "?[X]");
	    break;
	}
	case 4 : {
	    format (VERT_BRACKETS, "dg_external_idname", "X");
	    break;
	}
	case 5 : {
	    format (VERT_BRACKETS, "dg_instance_idname", "?[Y]YW*[h]");
	    break;
	}
	case 6 : {
	    format (VERT_BRACKETS, "dg_sourcestring_idname", "X");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_IDNAME", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_MACRO */

long
de_dg_macro(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "dg_function_macro", "WY*[Y]X");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "dg_include_macro", "WU*[Z]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "dg_object_macro", "WYX");
	    break;
	}
	case 4 : {
	    format (VERT_BRACKETS, "dg_undef_macro", "WY");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_MACRO", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_NAME */

long
de_dg_name(void)
{
    long n = tdf_de_tdfextint (tdfr, 5);
    switch (n) {
	case 1 : {
	    sortname sn = find_sortname ('h');
	    IGNORE de_token_aux (sn, "dg_name");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "dg_tag_name", "Jh");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "dg_constant_name", "h");
	    break;
	}
	case 4 : {
	    format (VERT_BRACKETS, "dg_entry_family_name", "hO");
	    break;
	}
	case 5 : {
	    format (VERT_BRACKETS, "dg_entry_name", "YW\015?[o]?[O]");
	    break;
	}
	case 6 : {
	    format (VERT_BRACKETS, "dg_inlined_name", "hJ");
	    break;
	}
	case 7 : {
	    format (VERT_BRACKETS, "dg_is_spec_name", "h?[b]");
	    break;
	}
	case 8 : {
	    format (VERT_BRACKETS, "dg_module_name", "YWk?[x]?[J]");
	    break;
	}
	case 9 : {
	    format (VERT_BRACKETS, "dg_namespace_name", "YWk");
	    break;
	}
	case 10 : {
	    format (VERT_BRACKETS, "dg_object_name", "YW\015?[x]?[o]");
	    break;
	}
	case 11 : {
	    format (VERT_BRACKETS, "dg_proc_name", "YW\015?[x]?[o]?[\020]b?[*[\015]]?[J]");
	    break;
	}
	case 12 : {
	    format (VERT_BRACKETS, "dg_program_name", "YWx");
	    break;
	}
	case 13 : {
	    format (VERT_BRACKETS, "dg_rep_clause_name", "hx");
	    break;
	}
	case 14 : {
	    format (VERT_BRACKETS, "dg_spec_ref_name", "Jh");
	    break;
	}
	case 15 : {
	    format (VERT_BRACKETS, "dg_subunit_name", "Jhn?[o]");
	    break;
	}
	case 16 : {
	    format (VERT_BRACKETS, "dg_type_name", "?[Y]W?[o]?[\015]b?[b]?[*[\011]]");
	    break;
	}
	case 17 : {
	    format (VERT_BRACKETS, "dg_visibility_name", "Jn?[Y]?[W]?[o]?[\015]");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_NAME", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_NAMELIST */

long
de_dg_namelist(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "dg_tag_namelist", "Jk");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "make_dg_namelist", "*[h]");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_NAMELIST", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_PARAM */

long
de_dg_param(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "dg_object_param", "?[Y]?[W]?[\013]\015?[\012]");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "dg_type_param", "?[Y]?[W]*[p]");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_PARAM", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_PARAM_MODE */

long
de_dg_param_mode(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    out ("dg_in_mode");
	    break;
	}
	case 2 : {
	    out ("dg_inout_mode");
	    break;
	}
	case 3 : {
	    out ("dg_out_mode");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_PARAM_MODE", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_QUALIFIER */

long
de_dg_qualifier(void)
{
    long n = tdf_de_tdfextint (tdfr, 3);
    switch (n) {
	case 1 : {
	    out ("dg_aliased_qualifier");
	    break;
	}
	case 2 : {
	    out ("dg_class_wide_qualifier");
	    break;
	}
	case 3 : {
	    out ("dg_const_qualifier");
	    break;
	}
	case 4 : {
	    out ("dg_limited_qualifier");
	    break;
	}
	case 5 : {
	    out ("dg_volatile_qualifier");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_QUALIFIER", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_SOURCEPOS */

long
de_dg_sourcepos(void)
{
    long n = tdf_de_tdfextint (tdfr, 3);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "dg_file_sourcepos", "U");
	    break;
	}
	case 2 : {
	    out ("dg_global_sourcepos");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "dg_mark_sourcepos", "Unn");
	    break;
	}
	case 4 : {
	    out ("dg_null_sourcepos");
	    break;
	}
	case 5 : {
	    format (VERT_BRACKETS, "dg_span_sourcepos", "Unn?[U]nn");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_SOURCEPOS", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_TAG */

long
de_dg_tag(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    switch (n) {
	case 1 : {
	    long t = tdf_int ();
	    out_object (t, (object *) null, var_dg_tag);
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_TAG", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_TYPE */

long
de_dg_type(void)
{
    long n = tdf_de_tdfextint (tdfr, 6);
    switch (n) {
	case 1 : {
	    sortname sn = find_sortname ('\015');
	    IGNORE de_token_aux (sn, "dg_type");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "dg_tag_type", "J\015");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "dg_address_type", "YS");
	    break;
	}
	case 4 : {
	    format (VERT_BRACKETS, "dg_array_type", "\015x?[b]*[O]");
	    break;
	}
	case 5 : {
	    format (VERT_BRACKETS, "dg_bitfield_type", "\015BS");
	    break;
	}
	case 6 : {
	    format (VERT_BRACKETS, "dg_boolean_type", "Yv");
	    break;
	}
	case 7 : {
	    format (VERT_BRACKETS, "dg_char_type", "Yv");
	    break;
	}
	case 8 : {
	    format (VERT_BRACKETS, "dg_class_type", "*[y]*[z]?[\017]*[J]?[S]?[J]?[J]?[Y]?[W]b?[J]?[J]b?[b]");
	    break;
	}
	case 9 : {
	    format (VERT_BRACKETS, "dg_complex_float_type", "Yf");
	    break;
	}
	case 10 : {
	    format (VERT_BRACKETS, "dg_enum_type", "*[E]?[Y]?[W]Sb");
	    break;
	}
	case 11 : {
	    format (VERT_BRACKETS, "dg_file_type", "\015S");
	    break;
	}
	case 12 : {
	    format (VERT_BRACKETS, "dg_fixed_point_type", "\015x?[x]?[x]");
	    break;
	}
	case 13 : {
	    format (VERT_BRACKETS, "dg_float_type", "Yf");
	    break;
	}
	case 14 : {
	    format (VERT_BRACKETS, "dg_floating_digits_type", "\015x");
	    break;
	}
	case 15 : {
	    format (VERT_BRACKETS, "dg_inlined_type", "\015J");
	    break;
	}
	case 16 : {
	    format (VERT_BRACKETS, "dg_integer_type", "Yv");
	    break;
	}
	case 17 : {
	    format (VERT_BRACKETS, "dg_is_spec_type", "\015");
	    break;
	}
	case 18 : {
	    format (VERT_BRACKETS, "dg_modular_type", "\015x");
	    break;
	}
	case 19 : {
	    format (VERT_BRACKETS, "dg_named_type", "J");
	    break;
	}
	case 20 : {
	    format (VERT_BRACKETS, "dg_packed_type", "\015S");
	    break;
	}
	case 21 : {
	    format (VERT_BRACKETS, "dg_pointer_type", "\015?[b]");
	    break;
	}
	case 22 : {
	    format (VERT_BRACKETS, "dg_proc_type", "*[p]\015?[b]?[n]?[n]?[P]");
	    break;
	}
	case 23 : {
	    format (VERT_BRACKETS, "dg_ptr_memdata_type", "J\015S?[J]");
	    break;
	}
	case 24 : {
	    format (VERT_BRACKETS, "dg_ptr_memfn_type", "J\015S?[J]");
	    break;
	}
	case 25 : {
	    format (VERT_BRACKETS, "dg_qualified_type", "\014\015");
	    break;
	}
	case 26 : {
	    format (VERT_BRACKETS, "dg_reference_type", "\015");
	    break;
	}
	case 27 : {
	    format (VERT_BRACKETS, "dg_set_type", "\015S");
	    break;
	}
	case 28 : {
	    format (VERT_BRACKETS, "dg_spec_ref_type", "J\015");
	    break;
	}
	case 29 : {
	    format (VERT_BRACKETS, "dg_string_type", "Jxx");
	    break;
	}
	case 30 : {
	    format (VERT_BRACKETS, "dg_struct_type", "*[z]?[S]?[Y]?[W]?[\017]bb");
	    break;
	}
	case 31 : {
	    format (VERT_BRACKETS, "dg_subrange_type", "\015ww");
	    break;
	}
	case 32 : {
	    format (VERT_BRACKETS, "dg_synchronous_type", "YW*[h]J*[z]?[\017]?[S]b?[J]");
	    break;
	}
	case 33 : {
	    format (VERT_BRACKETS, "dg_task_type", "YW*[h]JJ*[z]?[\017]?[S]b?[J]");
	    break;
	}
	case 34 : {
	    format (VERT_BRACKETS, "dg_unknown_type", "S");
	    break;
	}
	case 35 : {
	    out ("dg_void_type");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_TYPE", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_VARIANT */

long
de_dg_variant(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "make_dg_variant", "*[K]*[z]");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_VARIANT", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_VARPART */

long
de_dg_varpart(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "dg_discrim_varpart", "z*[\016]");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "dg_sibl_discrim_varpart", "J*[\016]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "dg_undiscrim_varpart", "\015*[\016]");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_VARPART", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DG_VIRTUALITY */

long
de_dg_virtuality(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    out ("dg_abstract_virtuality");
	    break;
	}
	case 2 : {
	    out ("dg_virtual_virtuality");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DG_VIRTUALITY", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DIAG_DESCRIPTOR */

long
de_diag_descriptor(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "diag_desc_id", "$Mxd");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "diag_desc_struct", "$Md");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "diag_desc_typedef", "$Md");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DIAG_DESCRIPTOR", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DIAG_TAG */

long
de_diag_tag(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    switch (n) {
	case 1 : {
	    long t = tdf_int ();
	    out_object (t, (object *) null, var_diag_tag);
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DIAG_TAG", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DIAG_TAGDEF */

long
de_diag_tagdef(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    if (n < 1 || n > 1) {
	out ("<error>");
	MSG_illegal_st_value("DIAG_TAGDEF", n);
	n = -1;
    }
    return (n);
}


/* DECODE A DIAG_TQ */

long
de_diag_tq(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "add_diag_const", "g");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "add_diag_volatile", "g");
	    break;
	}
	case 3 : {
	    out ("diag_tq_null");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DIAG_TQ", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A DIAG_TYPE */

long
de_diag_type(void)
{
    long n = tdf_de_tdfextint (tdfr, 4);
    switch (n) {
	case 1 : {
	    sortname sn = find_sortname ('d');
	    IGNORE de_token_aux (sn, "diag_type");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "diag_array", "dxxxd");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "diag_bitfield", "dn");
	    break;
	}
	case 4 : {
	    format (VERT_BRACKETS, "diag_enum", "d$*[x$]");
	    break;
	}
	case 5 : {
	    format (VERT_BRACKETS, "diag_floating_variety", "f");
	    break;
	}
	case 6 : {
	    format (VERT_BRACKETS, "diag_loc", "dg");
	    break;
	}
	case 7 : {
	    format (VERT_BRACKETS, "diag_proc", "*[d]bd");
	    break;
	}
	case 8 : {
	    format (VERT_BRACKETS, "diag_ptr", "dg");
	    break;
	}
	case 9 : {
	    format (VERT_BRACKETS, "diag_struct", "S$*[$xd]");
	    break;
	}
	case 10 : {
	    out ("diag_type_null");
	    break;
	}
	case 11 : {
	    format (VERT_BRACKETS, "diag_union", "S$*[$xd]");
	    break;
	}
	case 12 : {
	    format (VERT_BRACKETS, "diag_variety", "v");
	    break;
	}
	case 13 : {
	    format (VERT_BRACKETS, "use_diag_tag", "I");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("DIAG_TYPE", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A ERROR_CODE */

long
de_error_code(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    out ("nil_access");
	    break;
	}
	case 2 : {
	    out ("overflow");
	    break;
	}
	case 3 : {
	    out ("stack_overflow");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("ERROR_CODE", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A ERROR_TREATMENT */

long
de_error_treatment(void)
{
    long n = tdf_de_tdfextint (tdfr, 3);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_error_treatment, "error_treatment");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "errt_cond", "x@[e]@[e]");
	    break;
	}
	case 3 : {
	    out ("continue");
	    break;
	}
	case 4 : {
	    format (VERT_BRACKETS, "error_jump", "l");
	    break;
	}
	case 5 : {
	    format (VERT_BRACKETS, "trap", "*[c]");
	    break;
	}
	case 6 : {
	    out ("wrap");
	    break;
	}
	case 7 : {
	    out ("impossible");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("ERROR_TREATMENT", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A EXP */

long
de_exp(void)
{
    long n = tdf_de_tdfextint (tdfr, 7);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_exp, "exp");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "exp_cond", "x@[x]@[x]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "abs", "ex");
	    break;
	}
	case 4 : {
	    format (VERT_BRACKETS, "add_to_ptr", "xx");
	    break;
	}
	case 5 : {
	    format (VERT_BRACKETS, "and", "xx");
	    break;
	}
	case 6 : {
	    format (VERT_BRACKETS, "apply_proc", "Sx*[x]?[x]");
	    break;
	}
	case 7 : {
	    format (VERT_BRACKETS, "apply_general_proc", "S?[P]x*[?[t&]x]q{x}");
	    break;
	}
	case 8 : {
	    format (VERT_BRACKETS, "assign", "xx");
	    break;
	}
	case 9 : {
	    format (VERT_BRACKETS, "assign_with_mode", "mxx");
	    break;
	}
	case 10 : {
	    format (VERT_BRACKETS, "bitfield_assign", "xxx");
	    break;
	}
	case 11 : {
	    format (VERT_BRACKETS, "bitfield_assign_with_mode", "mxxx");
	    break;
	}
	case 12 : {
	    format (VERT_BRACKETS, "bitfield_contents", "Bxx");
	    break;
	}
	case 13 : {
	    format (VERT_BRACKETS, "bitfield_contents_with_mode", "mBxx");
	    break;
	}
	case 14 : {
	    /* Decode string "bx*[lss]" */
	    de_case ("case");
	    break;
	}
	case 15 : {
	    format (VERT_BRACKETS, "change_bitfield_to_int", "vx");
	    break;
	}
	case 16 : {
	    format (VERT_BRACKETS, "change_floating_variety", "efx");
	    break;
	}
	case 17 : {
	    format (VERT_BRACKETS, "change_variety", "evx");
	    break;
	}
	case 18 : {
	    format (VERT_BRACKETS, "change_int_to_bitfield", "Bx");
	    break;
	}
	case 19 : {
	    format (VERT_BRACKETS, "complex_conjugate", "x");
	    break;
	}
	case 20 : {
	    format (VERT_BRACKETS, "component", "Sxx");
	    break;
	}
	case 21 : {
	    format (VERT_BRACKETS, "concat_nof", "xx");
	    break;
	}
	case 22 : {
	    format (VERT_BRACKETS, "conditional", "l&{xx}");
	    break;
	}
	case 23 : {
	    format (VERT_BRACKETS, "contents", "Sx");
	    break;
	}
	case 24 : {
	    format (VERT_BRACKETS, "contents_with_mode", "mSx");
	    break;
	}
	case 25 : {
	    out ("current_env");
	    break;
	}
	case 26 : {
	    format (VERT_BRACKETS, "div0", "eexx");
	    break;
	}
	case 27 : {
	    format (VERT_BRACKETS, "div1", "eexx");
	    break;
	}
	case 28 : {
	    format (VERT_BRACKETS, "div2", "eexx");
	    break;
	}
	case 29 : {
	    format (VERT_BRACKETS, "env_offset", "aat");
	    break;
	}
	case 30 : {
	    format (VERT_BRACKETS, "env_size", "t");
	    break;
	}
	case 31 : {
	    format (VERT_BRACKETS, "fail_installer", "X");
	    break;
	}
	case 32 : {
	    format (VERT_BRACKETS, "float_int", "efx");
	    break;
	}
	case 33 : {
	    format (VERT_BRACKETS, "floating_abs", "ex");
	    break;
	}
	case 34 : {
	    format (VERT_BRACKETS, "floating_div", "exx");
	    break;
	}
	case 35 : {
	    format (VERT_BRACKETS, "floating_minus", "exx");
	    break;
	}
	case 36 : {
	    format (VERT_BRACKETS, "floating_maximum", "exx");
	    break;
	}
	case 37 : {
	    format (VERT_BRACKETS, "floating_minimum", "exx");
	    break;
	}
	case 38 : {
	    format (VERT_BRACKETS, "floating_mult", "e*[x]");
	    break;
	}
	case 39 : {
	    format (VERT_BRACKETS, "floating_negate", "ex");
	    break;
	}
	case 40 : {
	    format (VERT_BRACKETS, "floating_plus", "e*[x]");
	    break;
	}
	case 41 : {
	    format (VERT_BRACKETS, "floating_power", "exx");
	    break;
	}
	case 42 : {
	    format (VERT_BRACKETS, "floating_test", "?[n]eNlxx");
	    break;
	}
	case 43 : {
	    format (VERT_BRACKETS, "goto", "l");
	    break;
	}
	case 44 : {
	    format (VERT_BRACKETS, "goto_local_lv", "x");
	    break;
	}
	case 45 : {
	    format (VERT_BRACKETS, "identify", "?[u]t&x{x}");
	    break;
	}
	case 46 : {
	    format (VERT_BRACKETS, "ignorable", "x");
	    break;
	}
	case 47 : {
	    format (VERT_BRACKETS, "imaginary_part", "x");
	    break;
	}
	case 48 : {
	    format (VERT_BRACKETS, "initial_value", "{x}");
	    break;
	}
	case 49 : {
	    format (VERT_BRACKETS, "integer_test", "?[n]Nlxx");
	    break;
	}
	case 50 : {
	    /* Decode string "*[l&]{x*[x]}" */
	    de_labelled ("labelled");
	    break;
	}
	case 51 : {
	    format (VERT_BRACKETS, "last_local", "x");
	    break;
	}
	case 52 : {
	    format (VERT_BRACKETS, "local_alloc", "x");
	    break;
	}
	case 53 : {
	    format (VERT_BRACKETS, "local_alloc_check", "x");
	    break;
	}
	case 54 : {
	    format (VERT_BRACKETS, "local_free", "xx");
	    break;
	}
	case 55 : {
	    out ("local_free_all");
	    break;
	}
	case 56 : {
	    format (VERT_BRACKETS, "long_jump", "xx");
	    break;
	}
	case 57 : {
	    format (VERT_BRACKETS, "make_complex", "fxx");
	    break;
	}
	case 58 : {
	    format (VERT_BRACKETS, "make_compound", "x*[x]");
	    break;
	}
	case 59 : {
	    format (VERT_BRACKETS, "make_floating", "frbXns");
	    break;
	}
	case 60 : {
	    format (VERT_BRACKETS, "make_general_proc", "S?[P]*[S?[u]t&]*[S?[u]t&]{x}");
	    break;
	}
	case 61 : {
	    format (VERT_BRACKETS, "make_int", "vs");
	    break;
	}
	case 62 : {
	    format (VERT_BRACKETS, "make_local_lv", "l");
	    break;
	}
	case 63 : {
	    format (VERT_BRACKETS, "make_nof", "*[x]");
	    break;
	}
	case 64 : {
	    format (VERT_BRACKETS, "make_nof_int", "vX");
	    break;
	}
	case 65 : {
	    out ("make_null_local_lv");
	    break;
	}
	case 66 : {
	    out ("make_null_proc");
	    break;
	}
	case 67 : {
	    format (VERT_BRACKETS, "make_null_ptr", "a");
	    break;
	}
	case 68 : {
	    /* Decode string "S*[S?[u]t&]?[t&?[u]]{x}" */
	    de_make_proc ("make_proc");
	    break;
	}
	case 116 : {
	    format (VERT_BRACKETS, "make_stack_limit", "xxx");
	    break;
	}
	case 69 : {
	    out ("make_top");
	    break;
	}
	case 70 : {
	    format (VERT_BRACKETS, "make_value", "S");
	    break;
	}
	case 71 : {
	    format (VERT_BRACKETS, "maximum", "xx");
	    break;
	}
	case 72 : {
	    format (VERT_BRACKETS, "minimum", "xx");
	    break;
	}
	case 73 : {
	    format (VERT_BRACKETS, "minus", "exx");
	    break;
	}
	case 74 : {
	    format (VERT_BRACKETS, "move_some", "mxxx");
	    break;
	}
	case 75 : {
	    format (VERT_BRACKETS, "mult", "exx");
	    break;
	}
	case 76 : {
	    format (VERT_BRACKETS, "n_copies", "nx");
	    break;
	}
	case 77 : {
	    format (VERT_BRACKETS, "negate", "ex");
	    break;
	}
	case 78 : {
	    format (VERT_BRACKETS, "not", "x");
	    break;
	}
	case 79 : {
	    format (VERT_BRACKETS, "obtain_tag", "t");
	    break;
	}
	case 80 : {
	    format (VERT_BRACKETS, "offset_add", "xx");
	    break;
	}
	case 81 : {
	    format (VERT_BRACKETS, "offset_div", "vxx");
	    break;
	}
	case 82 : {
	    format (VERT_BRACKETS, "offset_div_by_int", "xx");
	    break;
	}
	case 83 : {
	    format (VERT_BRACKETS, "offset_max", "xx");
	    break;
	}
	case 84 : {
	    format (VERT_BRACKETS, "offset_mult", "xx");
	    break;
	}
	case 85 : {
	    format (VERT_BRACKETS, "offset_negate", "x");
	    break;
	}
	case 86 : {
	    format (VERT_BRACKETS, "offset_pad", "ax");
	    break;
	}
	case 87 : {
	    format (VERT_BRACKETS, "offset_subtract", "xx");
	    break;
	}
	case 88 : {
	    format (VERT_BRACKETS, "offset_test", "?[n]Nlxx");
	    break;
	}
	case 89 : {
	    format (VERT_BRACKETS, "offset_zero", "a");
	    break;
	}
	case 90 : {
	    format (VERT_BRACKETS, "or", "xx");
	    break;
	}
	case 91 : {
	    format (VERT_BRACKETS, "plus", "exx");
	    break;
	}
	case 92 : {
	    format (VERT_BRACKETS, "pointer_test", "?[n]Nlxx");
	    break;
	}
	case 93 : {
	    format (VERT_BRACKETS, "power", "exx");
	    break;
	}
	case 94 : {
	    format (VERT_BRACKETS, "proc_test", "?[n]Nlxx");
	    break;
	}
	case 95 : {
	    format (VERT_BRACKETS, "profile", "n");
	    break;
	}
	case 96 : {
	    format (VERT_BRACKETS, "real_part", "x");
	    break;
	}
	case 97 : {
	    format (VERT_BRACKETS, "rem0", "eexx");
	    break;
	}
	case 98 : {
	    format (VERT_BRACKETS, "rem1", "eexx");
	    break;
	}
	case 99 : {
	    format (VERT_BRACKETS, "rem2", "eexx");
	    break;
	}
	case 100 : {
	    format (VERT_BRACKETS, "repeat", "l&{xx}");
	    break;
	}
	case 101 : {
	    format (VERT_BRACKETS, "return", "x");
	    break;
	}
	case 102 : {
	    format (VERT_BRACKETS, "return_to_label", "x");
	    break;
	}
	case 103 : {
	    format (VERT_BRACKETS, "round_with_mode", "ervx");
	    break;
	}
	case 104 : {
	    format (VERT_BRACKETS, "rotate_left", "xx");
	    break;
	}
	case 105 : {
	    format (VERT_BRACKETS, "rotate_right", "xx");
	    break;
	}
	case 106 : {
	    /* Decode string "*[x]x" */
	    de_sequence ("sequence");
	    break;
	}
	case 107 : {
	    format (VERT_BRACKETS, "set_stack_limit", "x");
	    break;
	}
	case 108 : {
	    format (VERT_BRACKETS, "shape_offset", "S");
	    break;
	}
	case 109 : {
	    format (VERT_BRACKETS, "shift_left", "exx");
	    break;
	}
	case 110 : {
	    format (VERT_BRACKETS, "shift_right", "xx");
	    break;
	}
	case 111 : {
	    format (VERT_BRACKETS, "subtract_ptrs", "xx");
	    break;
	}
	case 112 : {
	    format (VERT_BRACKETS, "tail_call", "?[P]xq");
	    break;
	}
	case 113 : {
	    format (VERT_BRACKETS, "untidy_return", "x");
	    break;
	}
	case 114 : {
	    format (VERT_BRACKETS, "variable", "?[u]t&x{x}");
	    break;
	}
	case 115 : {
	    format (VERT_BRACKETS, "xor", "xx");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("EXP", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A EXTERNAL */

long
de_external(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    if (n < 1 || n > 3) {
	out ("<error>");
	MSG_illegal_st_value("EXTERNAL", n);
	n = -1;
    }
    return (n);
}


/* DECODE A FILENAME */

long
de_filename(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    sortname sn = find_sortname ('Q');
	    IGNORE de_token_aux (sn, "filename");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "make_filename", "n$$");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("FILENAME", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A FLOATING_VARIETY */

long
de_floating_variety(void)
{
    long n = tdf_de_tdfextint (tdfr, 3);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_floating_variety, "floating_variety");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "flvar_cond", "x@[f]@[f]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "flvar_parms", "nnnn");
	    break;
	}
	case 4 : {
	    format (VERT_BRACKETS, "complex_parms", "nnnn");
	    break;
	}
	case 5 : {
	    format (VERT_BRACKETS, "float_of_complex", "S");
	    break;
	}
	case 6 : {
	    format (VERT_BRACKETS, "complex_of_float", "S");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("FLOATING_VARIETY", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A LABEL */

long
de_label(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    switch (n) {
	case 2 : {
	    IGNORE de_token_aux (sort_label, "label");
	    break;
	}
	case 1 : {
	    long t = tdf_int ();
	    de_make_label (t);
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("LABEL", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A LINKINFO */

long
de_linkinfo(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "static_name_def", "x$");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "make_comment", "$");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "make_weak_defn", "xx");
	    break;
	}
	case 4 : {
	    format (VERT_BRACKETS, "make_weak_symbol", "$x");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("LINKINFO", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A NAT */

long
de_nat(void)
{
    long n = tdf_de_tdfextint (tdfr, 3);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_nat, "nat");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "nat_cond", "x@[n]@[n]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "computed_nat", "x");
	    break;
	}
	case 4 : {
	    format (VERT_BRACKETS, "error_val", "c");
	    break;
	}
	case 5 : {
	    /* Decode string "i" */
	    de_make_nat ("make_nat");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("NAT", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A NTEST */

long
de_ntest(void)
{
    long n = tdf_de_tdfextint (tdfr, 4);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_ntest, "ntest");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "ntest_cond", "x@[N]@[N]");
	    break;
	}
	case 3 : {
	    out ("equal");
	    break;
	}
	case 4 : {
	    out ("greater_than");
	    break;
	}
	case 5 : {
	    out ("greater_than_or_equal");
	    break;
	}
	case 6 : {
	    out ("less_than");
	    break;
	}
	case 7 : {
	    out ("less_than_or_equal");
	    break;
	}
	case 8 : {
	    out ("not_equal");
	    break;
	}
	case 9 : {
	    out ("not_greater_than");
	    break;
	}
	case 10 : {
	    out ("not_greater_than_or_equal");
	    break;
	}
	case 11 : {
	    out ("not_less_than");
	    break;
	}
	case 12 : {
	    out ("not_less_than_or_equal");
	    break;
	}
	case 13 : {
	    out ("less_than_or_greater_than");
	    break;
	}
	case 14 : {
	    out ("not_less_than_and_not_greater_than");
	    break;
	}
	case 15 : {
	    out ("comparable");
	    break;
	}
	case 16 : {
	    out ("not_comparable");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("NTEST", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A PROCPROPS */

long
de_procprops(void)
{
    long n = tdf_de_tdfextint (tdfr, 4);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_procprops, "procprops");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "procprops_cond", "x@[P]@[P]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "add_procprops", "PP");
	    break;
	}
	case 4 : {
	    out ("check_stack");
	    break;
	}
	case 5 : {
	    out ("inline");
	    break;
	}
	case 6 : {
	    out ("no_long_jump_dest");
	    break;
	}
	case 7 : {
	    out ("untidy");
	    break;
	}
	case 8 : {
	    out ("var_callees");
	    break;
	}
	case 9 : {
	    out ("var_callers");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("PROCPROPS", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A ROUNDING_MODE */

long
de_rounding_mode(void)
{
    long n = tdf_de_tdfextint (tdfr, 3);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_rounding_mode, "rounding_mode");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "rounding_mode_cond", "x@[r]@[r]");
	    break;
	}
	case 3 : {
	    out ("round_as_state");
	    break;
	}
	case 4 : {
	    out ("to_nearest");
	    break;
	}
	case 5 : {
	    out ("toward_larger");
	    break;
	}
	case 6 : {
	    out ("toward_smaller");
	    break;
	}
	case 7 : {
	    out ("toward_zero");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("ROUNDING_MODE", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A SHAPE */

long
de_shape(void)
{
    long n = tdf_de_tdfextint (tdfr, 4);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_shape, "shape");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "shape_cond", "x@[S]@[S]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "bitfield", "B");
	    break;
	}
	case 4 : {
	    out ("bottom");
	    break;
	}
	case 5 : {
	    format (VERT_BRACKETS, "compound", "x");
	    break;
	}
	case 6 : {
	    format (VERT_BRACKETS, "floating", "f");
	    break;
	}
	case 7 : {
	    format (VERT_BRACKETS, "integer", "v");
	    break;
	}
	case 8 : {
	    format (VERT_BRACKETS, "nof", "nS");
	    break;
	}
	case 9 : {
	    format (VERT_BRACKETS, "offset", "aa");
	    break;
	}
	case 10 : {
	    format (VERT_BRACKETS, "pointer", "a");
	    break;
	}
	case 11 : {
	    out ("proc");
	    break;
	}
	case 12 : {
	    out ("top");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("SHAPE", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A SIGNED_NAT */

long
de_signed_nat(void)
{
    long n = tdf_de_tdfextint (tdfr, 3);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_signed_nat, "signed_nat");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "signed_nat_cond", "x@[s]@[s]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "computed_signed_nat", "x");
	    break;
	}
	case 4 : {
	    /* Decode string "ji" */
	    de_make_signed_nat ("make_signed_nat");
	    break;
	}
	case 5 : {
	    format (VERT_BRACKETS, "snat_from_nat", "bn");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("SIGNED_NAT", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A SORTNAME */

long
de_sortname(void)
{
    long n = tdf_de_tdfextint (tdfr, 5);
    if (n < 1 || n > 21) {
	out ("<error>");
	MSG_illegal_st_value("SORTNAME", n);
	n = -1;
    }
    return (n);
}


/* DECODE A SOURCEMARK */

long
de_sourcemark(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    switch (n) {
	case 1 : {
	    format (VERT_BRACKETS, "make_sourcemark", "Qnn");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("SOURCEMARK", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A STRING */

long
de_string(void)
{
    long n = tdf_de_tdfextint (tdfr, 3);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_string, "string");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "string_cond", "x@[X]@[X]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "concat_string", "XX");
	    break;
	}
	case 4 : {
	    /* Decode string "$" */
	    de_make_string ("make_string");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("STRING", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A TAG */

long
de_tag(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    switch (n) {
	case 2 : {
	    IGNORE de_token_aux (sort_tag, "tag");
	    break;
	}
	case 1 : {
	    long t = tdf_int ();
	    out_object (t, (object *) null, var_tag);
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("TAG", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A TAGDEC */

long
de_tagdec(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    if (n < 1 || n > 3) {
	out ("<error>");
	MSG_illegal_st_value("TAGDEC", n);
	n = -1;
    }
    return (n);
}


/* DECODE A TAGDEF */

long
de_tagdef(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    if (n < 1 || n > 3) {
	out ("<error>");
	MSG_illegal_st_value("TAGDEF", n);
	n = -1;
    }
    return (n);
}


/* DECODE A TOKDEC */

long
de_tokdec(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    if (n < 1 || n > 1) {
	out ("<error>");
	MSG_illegal_st_value("TOKDEC", n);
	n = -1;
    }
    return (n);
}


/* DECODE A TOKDEF */

long
de_tokdef(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    if (n < 1 || n > 1) {
	out ("<error>");
	MSG_illegal_st_value("TOKDEF", n);
	n = -1;
    }
    return (n);
}


/* DECODE A TOKEN */

long
de_token(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    if (n < 1 || n > 3) {
	out ("<error>");
	MSG_illegal_st_value("TOKEN", n);
	n = -1;
    }
    return (n);
}


/* DECODE A TOKEN_DEFN */

long
de_token_defn(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    if (n < 1 || n > 1) {
	out ("<error>");
	MSG_illegal_st_value("TOKEN_DEFN", n);
	n = -1;
    }
    return (n);
}


/* DECODE A TRANSFER_MODE */

long
de_transfer_mode(void)
{
    long n = tdf_de_tdfextint (tdfr, 3);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_transfer_mode, "transfer_mode");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "transfer_mode_cond", "x@[m]@[m]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "add_modes", "mm");
	    break;
	}
	case 4 : {
	    out ("overlap");
	    break;
	}
	case 5 : {
	    out ("standard_transfer_mode");
	    break;
	}
	case 6 : {
	    out ("trap_on_nil");
	    break;
	}
	case 7 : {
	    out ("volatile");
	    break;
	}
	case 8 : {
	    out ("complete");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("TRANSFER_MODE", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A VARIETY */

long
de_variety(void)
{
    long n = tdf_de_tdfextint (tdfr, 2);
    switch (n) {
	case 1 : {
	    IGNORE de_token_aux (sort_variety, "variety");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "var_cond", "x@[v]@[v]");
	    break;
	}
	case 3 : {
	    format (VERT_BRACKETS, "var_limits", "ss");
	    break;
	}
	case 4 : {
	    format (VERT_BRACKETS, "var_width", "bn");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("VARIETY", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/* DECODE A VERSION */

long
de_version(void)
{
    long n = tdf_de_tdfextint (tdfr, 1);
    switch (n) {
	case 1 : {
	    /* Decode string "ii" */
	    de_make_version ("make_version");
	    break;
	}
	case 2 : {
	    format (VERT_BRACKETS, "user_info", "X");
	    break;
	}
	default : {
	    out ("<error>");
	    MSG_illegal_st_value ("VERSION", n);
	    n = -1;
	    break;
	}
    }
    return (n);
}


/*
 *    SKIP TEXT ENCLOSED IN [...]
 *
 *    On input, s, points to the character '['.  The routine returns a
 *    pointer to the character following the corresponding ']'.
 */

static char *
skip_sub(char *s)
{
    char c = *(s++);
    if (c == '[') {
	int n = 0;
	while (c = *(s++), c != 0) {
	    if (c == '[') n++;
	    if (c == ']') {
		if (n == 0) return (s);
		n--;
	    }
	}
    }
    MSG_illegal_decoding_string ();
    return ("");
}


/*
 *    DECODE A STRING OF DECODE CHARACTERS
 *
 *    This routine takes a string of characters, reads it one character
 *    at a time, and, according to what it is, calls a particular TDF
 *    decoding routine (the character is vaguely mnemonic).  For example,
 *    decode ("Sn*[x]" ) means, decode a SHAPE and a NAT, then read a
 *    TDF integer and decode that number of EXPs.
 */

void
decode(char *str)
{
    char c;
    while (c = *(str++), c != 0) {
	switch (c) {
	    case '[' :
	    case '{' :
	    case '}' :
	    case '&' : {
		/* Ignore these cases */
		break;
	    }
	    case ']' : {
		/* Marks the end of a group */
		return;
	    }
	    case 'i' : {
		/* Decode an integer */
		long n = tdf_int ();
		out_int (n);
		break;
	    }
	    case '$' : {
		/* Decode a string */
		de_tdfstring_format ();
		break;
	    }
	    case 'T' : {
		/* Decode a token */
		IGNORE de_token_aux (sort_unknown, "token");
		break;
	    }
	    case 'F' : {
		/* Decode an unknown foreign sort */
		MSG_unknown_foreign_sort ();
		break;
	    }
	    case '*' : {
		/* The following text is repeated n times */
		long i, n;
		check_list ();
		n = tdf_int ();
		if (n == 0) {
		    out ("empty");
		} else {
		    for (i = 0; i < n; i++ ) decode (str + 1);
		}
		str = skip_sub (str);
		break;
	    }
	    case '+' : {
		/* The following text is repeated n + 1 times */
		long i, n;
		check_list ();
		n = tdf_int ();
		for (i = 0; i <= n; i++ ) decode (str + 1);
		str = skip_sub (str);
		break;
	    }
	    case '?' : {
		/* The following text is optional */
		if (tdf_bool ()) {
		    decode (str + 1);
		} else {
		    out ("-");
		}
		str = skip_sub (str);
		break;
	    }
	    case '@' : {
		/* The following text is a bitstream */
		tdf_pos p = tdf_int ();
		p += tdf_stream_tell (tdfr);
		decode (str + 1);
		if (p != tdf_stream_tell (tdfr)) {
		    MSG_bitstream_length_wrong ();
		}
		str = skip_sub (str);
		break;
	    }
	    case '|' : {
		/* Align input stream */
		tdf_de_align (tdfr);
		break;
	    }
	    case 'u' : IGNORE de_access (); break;
	    case 'A' : IGNORE de_al_tag (); break;
	    case 'a' : IGNORE de_alignment (); break;
	    case 'B' : IGNORE de_bitfield_variety (); break;
	    case 'b' : IGNORE de_bool (); break;
	    case 'q' : IGNORE de_callees (); break;
	    case 'G' : IGNORE de_dg (); break;
	    case 'o' : IGNORE de_dg_accessibility (); break;
	    case 'H' : IGNORE de_dg_append (); break;
	    case 'w' : IGNORE de_dg_bound (); break;
	    case 'y' : IGNORE de_dg_class_base (); break;
	    case 'z' : IGNORE de_dg_classmem (); break;
	    case 'C' : IGNORE de_dg_compilation (); break;
	    case '\011' : IGNORE de_dg_constraint (); break;
	    case '\012' : IGNORE de_dg_default (); break;
	    case 'O' : IGNORE de_dg_dim (); break;
	    case 'K' : IGNORE de_dg_discrim (); break;
	    case 'E' : IGNORE de_dg_enum (); break;
	    case 'U' : IGNORE de_dg_filename (); break;
	    case 'Y' : IGNORE de_dg_idname (); break;
	    case 'Z' : IGNORE de_dg_macro (); break;
	    case 'h' : IGNORE de_dg_name (); break;
	    case 'k' : IGNORE de_dg_namelist (); break;
	    case 'p' : IGNORE de_dg_param (); break;
	    case '\013' : IGNORE de_dg_param_mode (); break;
	    case '\014' : IGNORE de_dg_qualifier (); break;
	    case 'W' : IGNORE de_dg_sourcepos (); break;
	    case 'J' : IGNORE de_dg_tag (); break;
	    case '\015' : IGNORE de_dg_type (); break;
	    case '\016' : IGNORE de_dg_variant (); break;
	    case '\017' : IGNORE de_dg_varpart (); break;
	    case '\020' : IGNORE de_dg_virtuality (); break;
	    case 'D' : IGNORE de_diag_descriptor (); break;
	    case 'I' : IGNORE de_diag_tag (); break;
	    case 'g' : IGNORE de_diag_tq (); break;
	    case 'd' : IGNORE de_diag_type (); break;
	    case 'c' : IGNORE de_error_code (); break;
	    case 'e' : IGNORE de_error_treatment (); break;
	    case 'x' : IGNORE de_exp (); break;
	    case 'Q' : IGNORE de_filename (); break;
	    case 'f' : IGNORE de_floating_variety (); break;
	    case 'l' : IGNORE de_label (); break;
	    case 'L' : IGNORE de_linkinfo (); break;
	    case 'n' : IGNORE de_nat (); break;
	    case 'N' : IGNORE de_ntest (); break;
	    case 'P' : IGNORE de_procprops (); break;
	    case 'r' : IGNORE de_rounding_mode (); break;
	    case 'S' : IGNORE de_shape (); break;
	    case 's' : IGNORE de_signed_nat (); break;
	    case 'M' : IGNORE de_sourcemark (); break;
	    case 'X' : IGNORE de_string (); break;
	    case 't' : IGNORE de_tag (); break;
	    case 'm' : IGNORE de_transfer_mode (); break;
	    case 'v' : IGNORE de_variety (); break;
	    case 'V' : IGNORE de_version (); break;
	    default : {
		MSG_illegal_decode_letter (c);
		break;
	    }
	}
    }
    return;
}


/*
 *    FIND THE NAME AND DECODE LETTER ASSOCIATED WITH A SORT
 *
 *    This routine returns a sortid structure corresponding to the sort
 *    number n.
 */

sortid
find_sort(sortname n)
{
    sortid s;
    switch (n) {
	case sort_access : {
	    s.name = "ACCESS";
	    s.decode = 'u';
	    break;
	}
	case sort_al_tag : {
	    s.name = "AL_TAG";
	    s.decode = 'A';
	    break;
	}
	case sort_alignment : {
	    s.name = "ALIGNMENT";
	    s.decode = 'a';
	    break;
	}
	case sort_bitfield_variety : {
	    s.name = "BITFIELD_VARIETY";
	    s.decode = 'B';
	    break;
	}
	case sort_bool : {
	    s.name = "BOOL";
	    s.decode = 'b';
	    break;
	}
	case sort_error_treatment : {
	    s.name = "ERROR_TREATMENT";
	    s.decode = 'e';
	    break;
	}
	case sort_exp : {
	    s.name = "EXP";
	    s.decode = 'x';
	    break;
	}
	case sort_floating_variety : {
	    s.name = "FLOATING_VARIETY";
	    s.decode = 'f';
	    break;
	}
	case sort_label : {
	    s.name = "LABEL";
	    s.decode = 'l';
	    break;
	}
	case sort_nat : {
	    s.name = "NAT";
	    s.decode = 'n';
	    break;
	}
	case sort_ntest : {
	    s.name = "NTEST";
	    s.decode = 'N';
	    break;
	}
	case sort_procprops : {
	    s.name = "PROCPROPS";
	    s.decode = 'P';
	    break;
	}
	case sort_rounding_mode : {
	    s.name = "ROUNDING_MODE";
	    s.decode = 'r';
	    break;
	}
	case sort_shape : {
	    s.name = "SHAPE";
	    s.decode = 'S';
	    break;
	}
	case sort_signed_nat : {
	    s.name = "SIGNED_NAT";
	    s.decode = 's';
	    break;
	}
	case sort_string : {
	    s.name = "STRING";
	    s.decode = 'X';
	    break;
	}
	case sort_tag : {
	    s.name = "TAG";
	    s.decode = 't';
	    break;
	}
	case sort_transfer_mode : {
	    s.name = "TRANSFER_MODE";
	    s.decode = 'm';
	    break;
	}
	case sort_variety : {
	    s.name = "VARIETY";
	    s.decode = 'v';
	    break;
	}
	case sort_token : {
	    s.name = "TOKEN";
	    s.decode = 'T';
	    break;
	}
	case sort_foreign : {
	    s.name = "FOREIGN";
	    s.decode = 'F';
	    break;
	}
	default: {
	    int m = n - extra_sorts;
	    if (m >= 0 && m < no_foreign_sorts) {
		s.name = foreign_sorts[m].name;
		s.decode = foreign_sorts[m].decode;
	    } else {
		MSG_illegal_sort_value (n);
		s.name = "<error in SORT>";
		s.decode = 'F';
	    }
	    break;
	}
    }
    s.res = n;
    s.args = null;
    return (s);
}


/*
 *
 *    CONVERT A DECODE LETTER TO A SORT VALUE
 *
 *    This routine given a decode letter c returns the corresponding sort
 *    number.
 */

sortname
find_sortname(int c)
{
    long i;
    switch (c) {
	case 'u' : return (sort_access);
	case 'A' : return (sort_al_tag);
	case 'a' : return (sort_alignment);
	case 'B' : return (sort_bitfield_variety);
	case 'b' : return (sort_bool);
	case 'e' : return (sort_error_treatment);
	case 'x' : return (sort_exp);
	case 'f' : return (sort_floating_variety);
	case 'l' : return (sort_label);
	case 'n' : return (sort_nat);
	case 'N' : return (sort_ntest);
	case 'P' : return (sort_procprops);
	case 'r' : return (sort_rounding_mode);
	case 'S' : return (sort_shape);
	case 's' : return (sort_signed_nat);
	case 'X' : return (sort_string);
	case 't' : return (sort_tag);
	case 'm' : return (sort_transfer_mode);
	case 'v' : return (sort_variety);
	case 'T' : return (sort_token);
	case 'F' : return (sort_foreign);
    }
    for (i = 0; i < no_foreign_sorts; i++) {
	if (c == foreign_sorts[i].decode) {
	    return ((sortname) (extra_sorts + i));
	}
    }
    return (sort_unknown);
}


/*
 *    INITIALISE FOREIGN SORT NAMES
 *
 *    This routine initialises the array of foreign sort names.
 */

void
init_foreign_sorts(void)
{
    add_foreign_sort ("DG", "DG", 'G');
    add_foreign_sort ("DG_DIM", "DG_DIM", 'O');
    add_foreign_sort ("DG_FILENAME", "DG_FILENAME", 'U');
    add_foreign_sort ("DG_IDNAME", "DG_IDNAME", 'Y');
    add_foreign_sort ("DG_NAME", "DG_NAME", 'h');
    add_foreign_sort ("DG_TYPE", "DG_TYPE", '\015');
    add_foreign_sort ("DIAG_TYPE", "diag_type", 'd');
    add_foreign_sort ("FILENAME", "~diag_file", 'Q');
    return;
}


/*
 *    LINKAGE VARIABLE NUMBERS
 *
 *    Usually "tag" and "token" etc. appear in the var_types array.  These
 *    variables indicate where (negative values mean not at all).
 */

long var_al_tag = -1;
long var_dg_tag = -2;
long var_diag_tag = -3;
long var_tag = -4;
long var_token = -5;


/*
 *    FIND A LINKAGE VARIABLE CODE
 *
 *    This routine sets the nth element of the var_types array to the
 *    linkage variable indicated by the variable name s.
 */

char
find_variable(string s, long n)
{
    if (streq (s, "alignment")) {
	var_al_tag = n;
	return ('A');
    }
    if (streq (s, "dgtag")) {
	var_dg_tag = n;
	return ('J');
    }
    if (streq (s, "diagtag")) {
	var_diag_tag = n;
	return ('I');
    }
    if (streq (s, "tag")) {
	var_tag = n;
	return ('t');
    }
    if (streq (s, "token")) {
	var_token = n;
	return ('T');
    }
    return ('F');
}


/*
 *    FIND A EQUATION DECODING FUNCTION
 *
 *    This routine returns the unit decoding function used to deal with
 *    units with equation name s.  It also assigns a unit description to
 *    pt and a usage flag to po.
 */

equation_func
find_equation(string s, string *pt, int *po)
{
    if (streq (s, "aldef")) {
	*pt = MSG_al_tagdef_props;
	*po = OPT_al_tagdef_props;
	return (de_al_tagdef_props);
    }
    if (streq (s, "dgcompunit")) {
	*pt = MSG_dg_comp_props;
	*po = OPT_dg_comp_props;
	return (de_dg_comp_props);
    }
    if (streq (s, "diagtype")) {
	*pt = MSG_diag_type_unit;
	*po = OPT_diag_type_unit;
	return (de_diag_type_unit);
    }
    if (streq (s, "diagdef")) {
	*pt = MSG_diag_unit;
	*po = OPT_diag_unit;
	return (de_diag_unit);
    }
    if (streq (s, "linkinfo")) {
	*pt = MSG_linkinfo_props;
	*po = OPT_linkinfo_props;
	return (de_linkinfo_props);
    }
    if (streq (s, "tagdec")) {
	*pt = MSG_tagdec_props;
	*po = OPT_tagdec_props;
	return (de_tagdec_props);
    }
    if (streq (s, "tagdef")) {
	*pt = MSG_tagdef_props;
	*po = OPT_tagdef_props;
	return (de_tagdef_props);
    }
    if (streq (s, "tokdec")) {
	*pt = MSG_tokdec_props;
	*po = OPT_tokdec_props;
	return (de_tokdec_props);
    }
    if (streq (s, "tokdef")) {
	*pt = MSG_tokdef_props;
	*po = OPT_tokdef_props;
	return (de_tokdef_props);
    }
    if (streq (s, "versions")) {
	*pt = MSG_version_props;
	*po = OPT_version_props;
	return (de_version_props);
    }
    if (streq (s, "tld")) {
	*pt = MSG_tld_unit;
	*po = OPT_tld_unit;
	return (de_tld_unit);
    }
    if (streq (s, "tld2")) {
	*pt = MSG_tld2_unit;
	*po = OPT_tld2_unit;
	return (de_tld2_unit);
    }
    return (NULL);
}


syntax highlighted by Code2HTML, v. 0.9.1