Rev 2 | Blame | Compare with Previous | Last modification | View Log | RSS feed
/*
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 ) ;
}