Logo Search packages:      
Sourcecode: tendra version File versions  Download package

tdf.c

/*
             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.
*/


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

#include "config.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"
#include "utility.h"


/* DECODE A ACCESS */

long de_access
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal ACCESS value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A AL_TAG */

long de_al_tag
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal AL_TAG value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A AL_TAGDEF */

long de_al_tagdef
    PROTO_Z ()
{
    long n = fetch_extn ( 1 ) ;
    if ( n < 1 || n > 1 ) {
      out ( "<error>" ) ;
      input_error ( "Illegal AL_TAGDEF value, %ld", n ) ;
      n = -1 ;
    }
    return ( n ) ;
}


/* DECODE A ALIGNMENT */

long de_alignment
    PROTO_Z ()
{
    long n = fetch_extn ( 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 ( HORIZ_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 ( HORIZ_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>" ) ;
          input_error ( "Illegal ALIGNMENT value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A BITFIELD_VARIETY */

long de_bitfield_variety
    PROTO_Z ()
{
    long n = fetch_extn ( 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 ( HORIZ_BRACKETS, "bfvar_bits", "bn" ) ;
          break ;
      }
      default : {
          out ( "<error>" ) ;
          input_error ( "Illegal BITFIELD_VARIETY value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A BOOL */

long de_bool
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal BOOL value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A CALLEES */

long de_callees
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal CALLEES value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG */

long de_dg
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_ACCESSIBILITY */

long de_dg_accessibility
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_ACCESSIBILITY value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_APPEND */

long de_dg_append
    PROTO_Z ()
{
    long n = fetch_extn ( 1 ) ;
    switch ( n ) {
      case 1 : {
          format ( VERT_BRACKETS, "dg_name_append", "Jh" ) ;
          break ;
      }
      default : {
          out ( "<error>" ) ;
          input_error ( "Illegal DG_APPEND value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_BOUND */

long de_dg_bound
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_BOUND value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_CLASS_BASE */

long de_dg_class_base
    PROTO_Z ()
{
    long n = fetch_extn ( 1 ) ;
    switch ( n ) {
      case 1 : {
          format ( VERT_BRACKETS, "make_dg_class_base", "J?[W]?[T]?[o]?[\020]" ) ;
          break ;
      }
      default : {
          out ( "<error>" ) ;
          input_error ( "Illegal DG_CLASS_BASE value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_CLASSMEM */

long de_dg_classmem
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_CLASSMEM value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_COMPILATION */

long de_dg_compilation
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_COMPILATION value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_CONSTRAINT */

long de_dg_constraint
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_CONSTRAINT value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_DEFAULT */

long de_dg_default
    PROTO_Z ()
{
    long n = fetch_extn ( 1 ) ;
    switch ( n ) {
      case 1 : {
          format ( VERT_BRACKETS, "make_dg_default", "?[x]?[W]" ) ;
          break ;
      }
      default : {
          out ( "<error>" ) ;
          input_error ( "Illegal DG_DEFAULT value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_DIM */

long de_dg_dim
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_DIM value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_DISCRIM */

long de_dg_discrim
    PROTO_Z ()
{
    long n = fetch_extn ( 1 ) ;
    switch ( n ) {
      case 1 : {
          format ( VERT_BRACKETS, "make_dg_discrim", "xx" ) ;
          break ;
      }
      default : {
          out ( "<error>" ) ;
          input_error ( "Illegal DG_DISCRIM value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_ENUM */

long de_dg_enum
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_ENUM value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_FILENAME */

long de_dg_filename
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_FILENAME value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_IDNAME */

long de_dg_idname
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_IDNAME value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_MACRO */

long de_dg_macro
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_MACRO value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_NAME */

long de_dg_name
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_NAME value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_NAMELIST */

long de_dg_namelist
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_NAMELIST value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_PARAM */

long de_dg_param
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_PARAM value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_PARAM_MODE */

long de_dg_param_mode
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_PARAM_MODE value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_QUALIFIER */

long de_dg_qualifier
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_QUALIFIER value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_SOURCEPOS */

long de_dg_sourcepos
    PROTO_Z ()
{
    long n = fetch_extn ( 3 ) ;
    switch ( n ) {
      case 1 : {
          format ( HORIZ_BRACKETS, "dg_file_sourcepos", "U" ) ;
          break ;
      }
      case 2 : {
          out ( "dg_global_sourcepos" ) ;
          break ;
      }
      case 3 : {
          format ( HORIZ_BRACKETS, "dg_mark_sourcepos", "Unn" ) ;
          break ;
      }
      case 4 : {
          out ( "dg_null_sourcepos" ) ;
          break ;
      }
      case 5 : {
          format ( HORIZ_BRACKETS, "dg_span_sourcepos", "Unn?[U]nn" ) ;
          break ;
      }
      default : {
          out ( "<error>" ) ;
          input_error ( "Illegal DG_SOURCEPOS value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_TAG */

long de_dg_tag
    PROTO_Z ()
{
    long n = fetch_extn ( 1 ) ;
    switch ( n ) {
      case 1 : {
          long t = tdf_int () ;
          out_object ( t, ( object * ) null, var_dg_tag ) ;
          break ;
      }
      default : {
          out ( "<error>" ) ;
          input_error ( "Illegal DG_TAG value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_TYPE */

long de_dg_type
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_TYPE value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_VARIANT */

long de_dg_variant
    PROTO_Z ()
{
    long n = fetch_extn ( 1 ) ;
    switch ( n ) {
      case 1 : {
          format ( VERT_BRACKETS, "make_dg_variant", "*[K]*[z]" ) ;
          break ;
      }
      default : {
          out ( "<error>" ) ;
          input_error ( "Illegal DG_VARIANT value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_VARPART */

long de_dg_varpart
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DG_VARPART value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DG_VIRTUALITY */

long de_dg_virtuality
    PROTO_Z ()
{
    long n = fetch_extn ( 2 ) ;
    switch ( n ) {
      case 1 : {
          out ( "dg_abstract_virtuality" ) ;
          break ;
      }
      case 2 : {
          out ( "dg_virtual_virtuality" ) ;
          break ;
      }
      default : {
          out ( "<error>" ) ;
          input_error ( "Illegal DG_VIRTUALITY value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DIAG_DESCRIPTOR */

long de_diag_descriptor
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DIAG_DESCRIPTOR value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DIAG_TAG */

long de_diag_tag
    PROTO_Z ()
{
    long n = fetch_extn ( 1 ) ;
    switch ( n ) {
      case 1 : {
          long t = tdf_int () ;
          out_object ( t, ( object * ) null, var_diag_tag ) ;
          break ;
      }
      default : {
          out ( "<error>" ) ;
          input_error ( "Illegal DIAG_TAG value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DIAG_TAGDEF */

long de_diag_tagdef
    PROTO_Z ()
{
    long n = fetch_extn ( 1 ) ;
    if ( n < 1 || n > 1 ) {
      out ( "<error>" ) ;
      input_error ( "Illegal DIAG_TAGDEF value, %ld", n ) ;
      n = -1 ;
    }
    return ( n ) ;
}


/* DECODE A DIAG_TQ */

long de_diag_tq
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal DIAG_TQ value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A DIAG_TYPE */

long de_diag_type
    PROTO_Z ()
{
    long n = fetch_extn ( 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 ( HORIZ_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>" ) ;
          input_error ( "Illegal DIAG_TYPE value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A ERROR_CODE */

long de_error_code
    PROTO_Z ()
{
    long n = fetch_extn ( 2 ) ;
    switch ( n ) {
      case 1 : {
          out ( "nil_access" ) ;
          break ;
      }
      case 2 : {
          out ( "overflow" ) ;
          break ;
      }
      case 3 : {
          out ( "stack_overflow" ) ;
          break ;
      }
      default : {
          out ( "<error>" ) ;
          input_error ( "Illegal ERROR_CODE value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A ERROR_TREATMENT */

long de_error_treatment
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal ERROR_TREATMENT value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A EXP */

long de_exp
    PROTO_Z ()
{
    long n = fetch_extn ( 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 ( HORIZ_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 ( HORIZ_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 ( HORIZ_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>" ) ;
          input_error ( "Illegal EXP value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A EXTERNAL */

long de_external
    PROTO_Z ()
{
    long n = fetch_extn ( 2 ) ;
    if ( n < 1 || n > 3 ) {
      out ( "<error>" ) ;
      input_error ( "Illegal EXTERNAL value, %ld", n ) ;
      n = -1 ;
    }
    return ( n ) ;
}


/* DECODE A FILENAME */

long de_filename
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal FILENAME value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A FLOATING_VARIETY */

long de_floating_variety
    PROTO_Z ()
{
    long n = fetch_extn ( 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 ( HORIZ_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>" ) ;
          input_error ( "Illegal FLOATING_VARIETY value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A LABEL */

long de_label
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal LABEL value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A LINKINFO */

long de_linkinfo
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal LINKINFO value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A NAT */

long de_nat
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal NAT value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A NTEST */

long de_ntest
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal NTEST value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A PROCPROPS */

long de_procprops
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal PROCPROPS value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A ROUNDING_MODE */

long de_rounding_mode
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal ROUNDING_MODE value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A SHAPE */

long de_shape
    PROTO_Z ()
{
    long n = fetch_extn ( 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 ( HORIZ_BRACKETS, "integer", "v" ) ;
          break ;
      }
      case 8 : {
          format ( HORIZ_BRACKETS, "nof", "nS" ) ;
          break ;
      }
      case 9 : {
          format ( VERT_BRACKETS, "offset", "aa" ) ;
          break ;
      }
      case 10 : {
          format ( HORIZ_BRACKETS, "pointer", "a" ) ;
          break ;
      }
      case 11 : {
          out ( "proc" ) ;
          break ;
      }
      case 12 : {
          out ( "top" ) ;
          break ;
      }
      default : {
          out ( "<error>" ) ;
          input_error ( "Illegal SHAPE value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A SIGNED_NAT */

long de_signed_nat
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal SIGNED_NAT value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A SORTNAME */

long de_sortname
    PROTO_Z ()
{
    long n = fetch_extn ( 5 ) ;
    if ( n < 1 || n > 21 ) {
      out ( "<error>" ) ;
      input_error ( "Illegal SORTNAME value, %ld", n ) ;
      n = -1 ;
    }
    return ( n ) ;
}


/* DECODE A SOURCEMARK */

long de_sourcemark
    PROTO_Z ()
{
    long n = fetch_extn ( 1 ) ;
    switch ( n ) {
      case 1 : {
          format ( HORIZ_BRACKETS, "make_sourcemark", "Qnn" ) ;
          break ;
      }
      default : {
          out ( "<error>" ) ;
          input_error ( "Illegal SOURCEMARK value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A STRING */

long de_string
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal STRING value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A TAG */

long de_tag
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal TAG value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A TAGDEC */

long de_tagdec
    PROTO_Z ()
{
    long n = fetch_extn ( 2 ) ;
    if ( n < 1 || n > 3 ) {
      out ( "<error>" ) ;
      input_error ( "Illegal TAGDEC value, %ld", n ) ;
      n = -1 ;
    }
    return ( n ) ;
}


/* DECODE A TAGDEF */

long de_tagdef
    PROTO_Z ()
{
    long n = fetch_extn ( 2 ) ;
    if ( n < 1 || n > 3 ) {
      out ( "<error>" ) ;
      input_error ( "Illegal TAGDEF value, %ld", n ) ;
      n = -1 ;
    }
    return ( n ) ;
}


/* DECODE A TOKDEC */

long de_tokdec
    PROTO_Z ()
{
    long n = fetch_extn ( 1 ) ;
    if ( n < 1 || n > 1 ) {
      out ( "<error>" ) ;
      input_error ( "Illegal TOKDEC value, %ld", n ) ;
      n = -1 ;
    }
    return ( n ) ;
}


/* DECODE A TOKDEF */

long de_tokdef
    PROTO_Z ()
{
    long n = fetch_extn ( 1 ) ;
    if ( n < 1 || n > 1 ) {
      out ( "<error>" ) ;
      input_error ( "Illegal TOKDEF value, %ld", n ) ;
      n = -1 ;
    }
    return ( n ) ;
}


/* DECODE A TOKEN */

long de_token
    PROTO_Z ()
{
    long n = fetch_extn ( 2 ) ;
    if ( n < 1 || n > 3 ) {
      out ( "<error>" ) ;
      input_error ( "Illegal TOKEN value, %ld", n ) ;
      n = -1 ;
    }
    return ( n ) ;
}


/* DECODE A TOKEN_DEFN */

long de_token_defn
    PROTO_Z ()
{
    long n = fetch_extn ( 1 ) ;
    if ( n < 1 || n > 1 ) {
      out ( "<error>" ) ;
      input_error ( "Illegal TOKEN_DEFN value, %ld", n ) ;
      n = -1 ;
    }
    return ( n ) ;
}


/* DECODE A TRANSFER_MODE */

long de_transfer_mode
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal TRANSFER_MODE value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A VARIETY */

long de_variety
    PROTO_Z ()
{
    long n = fetch_extn ( 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 ( HORIZ_BRACKETS, "var_limits", "ss" ) ;
          break ;
      }
      case 4 : {
          format ( HORIZ_BRACKETS, "var_width", "bn" ) ;
          break ;
      }
      default : {
          out ( "<error>" ) ;
          input_error ( "Illegal VARIETY value, %ld", n ) ;
          n = -1 ;
          break ;
      }
    }
    return ( n ) ;
}


/* DECODE A VERSION */

long de_version
    PROTO_Z ()
{
    long n = fetch_extn ( 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>" ) ;
          input_error ( "Illegal VERSION value, %ld", 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
    PROTO_N ( ( s ) )
    PROTO_T ( 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-- ;
          }
      }
    }
    input_error ( "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
    PROTO_N ( ( str ) )
    PROTO_T ( 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 */
            input_error ( "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 */
            long p = tdf_int () ;
            p += posn ( here ) ;
            decode ( str + 1 ) ;
            if ( p != posn ( here ) ) {
                input_error ( "Bitstream length wrong" ) ;
            }
            str = skip_sub ( str ) ;
            break ;
          }
          case '|' : {
            /* Align input stream */
            byte_align () ;
            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 : {
            input_error ( "Illegal decode letter, %c", 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
    PROTO_N ( ( n ) )
    PROTO_T ( 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 {
            input_error ( "Illegal sort value, %d", 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
    PROTO_N ( ( c ) )
    PROTO_T ( 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
    PROTO_Z ()
{
    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
    PROTO_N ( ( s, n ) )
    PROTO_T ( string s X 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
    PROTO_N ( ( s, pt, po ) )
    PROTO_T ( string s X string *pt X 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 ) ;
}

Generated by  Doxygen 1.6.0   Back to index