Subversion Repositories tendra.SVN

/*

 * Copyright (c) 2002-2006 The TenDRA Project <http://www.tendra.org/>.

 * All rights reserved.

 *

 * Redistribution and use in source and binary forms, with or without

 * modification, are permitted provided that the following conditions are met:

 *

 * 1. Redistributions of source code must retain the above copyright notice,

 *    this list of conditions and the following disclaimer.

 * 2. Redistributions in binary form must reproduce the above copyright notice,

 *    this list of conditions and the following disclaimer in the documentation

 *    and/or other materials provided with the distribution.

 * 3. Neither the name of The TenDRA Project nor the names of its contributors

 *    may be used to endorse or promote products derived from this software

 *    without specific, prior written permission.

 *

 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS

 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,

 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR

 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR

 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,

 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;

 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,

 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

 *

 * $Id$

 */

/*

    		 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.

*/

#include "config.h"

#include "version.h"

#include "system.h"

#include "c_types.h"

#include "ctype_ops.h"

#include "etype_ops.h"

#include "exp_ops.h"

#include "graph_ops.h"

#include "hashid_ops.h"

#include "id_ops.h"

#include "itype_ops.h"

#include "member_ops.h"

#include "nat_ops.h"

#include "nspace_ops.h"

#include "tok_ops.h"

#include "type_ops.h"

#include "virt_ops.h"

#include "error.h"

#include "tdf.h"

#include "basetype.h"

#include "buffer.h"

#include "capsule.h"

#include "compile.h"

#include "constant.h"

#include "diag.h"

#include "diag2.h"

#include "encode.h"

#include "exp.h"

#include "expression.h"

#include "function.h"

#include "initialise.h"

#include "mangle.h"

#include "print.h"

#include "shape.h"

#include "stmt.h"

#include "struct.h"

#include "tok.h"

#include "ustring.h"

#if TDF_OUTPUT

/*

    STANDARD DIAGNOSTIC TOKENS

    These variables give the standard tokens used in the diagnostic

    output.

*/

static ulong diag_id_scope_tok = LINK_NONE;

static ulong exp_to_source_tok = LINK_NONE;

/*

    ENCODE A DIAGNOSTIC FILE NAME

    This routine adds the diagnostic file name given by posn to the

    bitstream bs.

*/

static BITSTREAM *

enc_diag_file(BITSTREAM *bs, PTR(POSITION)posn)

{

	ulong n = DEREF_ulong(posn_tok(posn));

	if (n == LINK_NONE) {

		BITSTREAM *ts;

		string bn = DEREF_string(posn_base(posn));

		string mn = ustrlit(find_machine());

		ulong date = DEREF_ulong(posn_datestamp(posn));

		n = capsule_no(NULL_string, VAR_token);

		COPY_ulong(posn_tok(posn), n);

		if (!output_date) {

			date = 0;

		}

		ts = enc_tokdef_start(n, "P", NIL(ulong), 0);

		ENC_make_filename(ts);

		ENC_make_nat(ts);

		ENC_INT(ts, date);

		ts = enc_ustring(ts, mn);

		ts = enc_ustring(ts, bn);

		enc_tokdef_end(n, ts);

	}

	/* Encode token application */

	ENC_filename_apply_token(bs);

	n = link_no(bs, n, VAR_token);

	ENC_make_tok(bs, n);

	ENC_LEN_SMALL(bs, 0);

	return (bs);

}

/*

    ENCODE A DIAGNOSTIC SOURCE MARK

    This routine adds the diagnostic source mark given by loc to the

    bitstream bs.

*/

static BITSTREAM *

enc_diag_loc(BITSTREAM *bs, PTR(LOCATION)loc)

{

	ulong ln, cn;

	PTR(POSITION)posn;

	if (IS_NULL_ptr(loc)) {

		ln = builtin_loc.line;

		cn = builtin_loc.line;

		posn = builtin_loc.posn;

	} else {

		ln = DEREF_ulong(loc_line(loc));

		cn = DEREF_ulong(loc_column(loc));

		posn = DEREF_ptr(loc_posn(loc));

	}

	ENC_make_sourcemark(bs);

	bs = enc_diag_file(bs, posn);

	ENC_make_nat(bs);

	ENC_INT(bs, ln);

	ENC_make_nat(bs);

	ENC_INT(bs, cn);

	return (bs);

}

/*

    ENCODE A DIAGNOSTIC IDENTIFIER NAME

    This routine adds the name of the identifier id to the bitstream bs

    as a TDF string.

*/

BITSTREAM *

enc_diag_name(BITSTREAM *bs, IDENTIFIER id, int q)

{

	string s = mangle_diag(id, q);

	bs = enc_ustring(bs, s);

	return (bs);

}

/*

    ENCODE THE START OF A DIAGNOSTIC TAG DEFINITION

    This routine encodes the start of a diagnostic tag definition for

    diagnostic tag number n.  It returns a bitstream to which the

    diagnostic type definition needs to be added.

*/

static BITSTREAM *

enc_diag_tagdef_start(ulong n)

{

	BITSTREAM *bs = start_bitstream(NIL(FILE), diagtype_unit->link);

	record_usage(n, VAR_diagtag, USAGE_DEFN);

	ENC_make_diag_tagdef(bs);

	n = link_no(bs, n, VAR_diagtag);

	ENC_INT(bs, n);

	return (bs);

}

/*

    ENCODE THE END OF A DIAGNOSTIC TAG DEFINITION

    This routine completes the definition of a diagnostic tag.  bs is the

    result of a previous call to enc_diag_tagdef_start.

*/

static void

enc_diag_tagdef_end(BITSTREAM *bs)

{

	count_item(bs);

	diagtype_unit = join_bitstreams(diagtype_unit, bs);

	return;

}

/*

    ENCODE A LIST OF DIAGNOSTIC BASE CLASSES

    This routine adds the list of diagnostic base classes given by br

    to the bitstream bs in reverse order.  A count of the number of bases

    is maintained in pm.

*/

static BITSTREAM *

enc_diag_bases(BITSTREAM *bs, LIST(GRAPH)br, unsigned *pm)

{

	if (!IS_NULL_list(br)) {

		GRAPH gs = DEREF_graph(HEAD_list(br));

		CLASS_TYPE cs = DEREF_ctype(graph_head(gs));

		IDENTIFIER cid = DEREF_id(ctype_name(cs));

		DECL_SPEC acc = DEREF_dspec(graph_access(gs));

		bs = enc_diag_bases(bs, TAIL_list(br), pm);

		bs = enc_diag_name(bs, cid, 0);

		bs = enc_base(bs, gs, 1);

		if (acc & dspec_virtual) {

			ENC_diag_ptr(bs);

			bs = enc_diag_ctype(bs, cs);

			ENC_diag_tq_null(bs);

		} else {

			bs = enc_diag_ctype(bs, cs);

		}

		(*pm)++;

	}

	return (bs);

}

/*

    ENCODE A LIST OF DIAGNOSTIC CLASS MEMBERS

    This routine adds the list of diagnostic class members given by mem

    to the bitstream bs in reverse order.  A count of the number of members

    is maintained in pm.

*/

static BITSTREAM *

enc_diag_mems(BITSTREAM *bs, MEMBER mem, unsigned *pm)

{

	if (!IS_NULL_member(mem)) {

		IDENTIFIER mid = DEREF_id(member_id(mem));

		TYPE s = DEREF_type(id_member_type(mid));

		mem = DEREF_member(member_next(mem));

		mem = next_data_member(mem, 2);

		bs = enc_diag_mems(bs, mem, pm);

		bs = enc_diag_name(bs, mid, 0);

		bs = enc_member(bs, mid);

		bs = enc_diag_type(bs, s, 0);

		(*pm)++;

	}

	return (bs);

}

/*

    ENCODE A DIAGNOSTIC VIRTUAL FUNCTION TABLE

    This routine adds the diagnostic information for the virtual function

    table vt to the bitstream bs.  A count of the number of items is

    maintained in pm.

*/

static BITSTREAM *

enc_diag_vtable(BITSTREAM *bs, VIRTUAL vt, unsigned *pm)

{

	while (!IS_NULL_virt(vt)) {

		OFFSET off = DEREF_off(virt_table_off(vt));

		if (IS_NULL_off(off)) {

			/* New virtual function table */

			ulong n = DEREF_ulong(virt_table_tok(vt));

			bs = enc_ustring(bs, ustrlit("__vptr"));

			ENC_exp_apply_token(bs);

			n = link_no(bs, n, VAR_token);

			ENC_make_tok(bs, n);

			ENC_LEN_SMALL(bs, 0);

			ENC_diag_ptr(bs);

			bs = enc_diag_special(bs, TOK_vtab_diag, VAR_diagtag);

			ENC_diag_tq_null(bs);

			(*pm)++;

		}

		vt = DEREF_virt(virt_next(vt));

	}

	return (bs);

}

/*

    LIST OF INCOMPLETE CLASSES

    This list is used to hold all the classes which are used while they

    are incomplete.  A diagnostic tag is introduced for each such class

    which may be defined later if the class is completed.

*/

static LIST(CLASS_TYPE)diag_classes = NULL_list(CLASS_TYPE);

/*

    DEFINE A DIAGNOSTIC TAG FOR A CLASS

    This routine defines a diagnostic tag for the class ct if it is complete

    or def is true.

*/

static ulong

enc_diag_class(CLASS_TYPE ct, int def)

{

	ulong tok = LINK_NONE;

	CLASS_INFO ci = DEREF_cinfo(ctype_info(ct));

	IDENTIFIER id = DEREF_id(ctype_name(ct));

	ulong n = DEREF_ulong(id_no(id));

	if (n == LINK_NONE) {

		/* Create diagnostic tag information */

		n = capsule_no(NULL_string, VAR_diagtag);

		COPY_ulong(id_no(id), n);

	}

	if ((ci & cinfo_complete) && (ci & cinfo_defined)) {

		/* Complete class */

		tok = compile_class(ct);

		def = 1;

	} else {

		/* Incomplete class */

		if (def) {

			tok = special_no(TOK_empty_shape);

		}

	}

	if (def) {

		/* Define diagnostic tag */

		unsigned m = 0;

		BITSTREAM *bs, *ts;

		GRAPH gr = DEREF_graph(ctype_base(ct));

		LIST(GRAPH)br = DEREF_list(graph_tails(gr));

		NAMESPACE ns = DEREF_nspace(ctype_member(ct));

		MEMBER mem = DEREF_member(nspace_ctype_first(ns));

		/* Encode diagnostic tag definition */

		bs = enc_diag_tagdef_start(n);

		ts = start_bitstream(NIL(FILE), bs->link);

		if (ci & cinfo_union) {

			ENC_diag_union(bs);

		} else {

			ENC_diag_struct(bs);

		}

		ENC_shape_apply_token(bs);

		tok = link_no(bs, tok, VAR_token);

		ENC_make_tok(bs, tok);

		ENC_LEN_SMALL(bs, 0);

		bs = enc_diag_name(bs, id, 1);

		mem = next_data_member(mem, 2);

		if (ci & cinfo_polymorphic) {

			VIRTUAL vt = DEREF_virt(ctype_virt(ct));

			ts = enc_diag_vtable(ts, vt, &m);

		}

		ts = enc_diag_mems(ts, mem, &m);

		ts = enc_diag_bases(ts, br, &m);

		ENC_LIST(bs, m);

		bs = join_bitstreams(bs, ts);

		enc_diag_tagdef_end(bs);

	} else {

		CONS_ctype(ct, diag_classes, diag_classes);

	}

	return (n);

}

/*

    DEFINE INCOMPLETE CLASSES

    This routine defines the diagnostic tags for the incomplete classes

    in the list above.

*/

int

enc_diag_pending(void)

{

	int changed = 0;

	if (output_diag) {

		LIST(CLASS_TYPE)p;

#if TDF_NEW_DIAG

		if (output_new_diag) {

			changed = enc_dg_pending();

			return (changed);

		}

#endif

		while (p = diag_classes, !IS_NULL_list(p)) {

			diag_classes = NULL_list(CLASS_TYPE);

			while (!IS_NULL_list(p)) {

				CLASS_TYPE ct;

				DESTROY_CONS_ctype(destroy, ct, p, p);

				IGNORE enc_diag_class(ct, 1);

				changed = 1;

			}

		}

	}

	return (changed);

}

/*

    ENCODE A DIAGNOSTIC CLASS TYPE

    This routine encodes the diagnostic information for the class type ct

    to the bitstream bs.

*/

BITSTREAM *

enc_diag_ctype(BITSTREAM *bs, CLASS_TYPE ct)

{

	IDENTIFIER id = DEREF_id(ctype_name(ct));

	ulong n = DEREF_ulong(id_no(id));

	if (n == LINK_NONE) {

		CLASS_INFO ci = DEREF_cinfo(ctype_info(ct));

		if (ci & cinfo_token) {

			/* Allow for tokenised types */

			TYPE t = DEREF_type(ctype_form(ct));

			bs = enc_diag_type(bs, t, 0);

			return (bs);

		}

		n = enc_diag_class(ct, 0);

	}

	n = link_no(bs, n, VAR_diagtag);

	ENC_use_diag_tag(bs);

	ENC_make_diag_tag(bs, n);

	return (bs);

}

/*

    ENCODE A DIAGNOSTIC ENUMERATION TYPE

    This routine encodes the diagnostic information for the enumeration

    type et to the bitstream bs.  This is represented by a diagnostic tag.

*/

static BITSTREAM *

enc_diag_etype(BITSTREAM *bs, ENUM_TYPE et)

{

	IDENTIFIER id = DEREF_id(etype_name(et));

	ulong n = DEREF_ulong(id_no(id));

	if (n == LINK_NONE) {

		/* Decompose enumeration type */

		BITSTREAM *ts;

		TYPE t = DEREF_type(etype_rep(et));

		LIST(IDENTIFIER)p = DEREF_list(etype_values(et));

		CLASS_INFO ei = DEREF_cinfo(etype_info(et));

		if (!(ei & cinfo_complete)) {

			bs = enc_diag_type(bs, t, 0);

			return (bs);

		}

		/* Encode diagnostic tag definition */

		n = capsule_no(NULL_string, VAR_diagtag);

		COPY_ulong(id_no(id), n);

		ts = enc_diag_tagdef_start(n);

		ENC_diag_enum(ts);

		ts = enc_diag_type(ts, t, 0);

		ts = enc_diag_name(ts, id, 1);

		ENC_LIST(ts, LENGTH_list(p));

		while (!IS_NULL_list(p)) {

			/* Scan through enumerators */

			IDENTIFIER pid = DEREF_id(HEAD_list(p));

			EXP e = DEREF_exp(id_enumerator_value(pid));

			ts = enc_exp(ts, e);

			ts = enc_diag_name(ts, pid, 1);

			p = TAIL_list(p);

		}

		enc_diag_tagdef_end(ts);

	}

	/* Encode diagnostic tag use */

	n = link_no(bs, n, VAR_diagtag);

	ENC_use_diag_tag(bs);

	ENC_make_diag_tag(bs, n);

	return (bs);

}

/*

    ENCODE A TOKENISED DIAGNOSTIC TYPE

    This routine adds the diagnostic information for the tokenised type

    id ( args ) to the bitstream bs.

*/

static BITSTREAM *

enc_diag_tok_type(BITSTREAM *bs, IDENTIFIER id, LIST(TOKEN)args)

{

	if (IS_NULL_list(args)) {

		ulong n = get_diag_tag(id, VAR_token);

		if (n == LINK_NONE) {

			/* Find external name */

			string s = mangle_name(id, VAR_diagtag, 0);

			n = capsule_no(s, VAR_diagtag);

			set_diag_tag(id, VAR_token, n);

		}

		n = link_no(bs, n, VAR_diagtag);

		ENC_use_diag_tag(bs);

		ENC_make_diag_tag(bs, n);

	} else {

		/* NOT YET IMPLEMENTED */

		ENC_diag_type_null(bs);

	}

	return (bs);

}

/*

    ENCODE A DIAGNOSTIC TYPE QUALIFIER

    This routine adds the diagnostic type qualifiers cv to the bitstream bs.

*/

static BITSTREAM *

enc_diag_type_qual(BITSTREAM *bs, CV_SPEC cv)

{

	if (cv & cv_const) {

		ENC_add_diag_const(bs);

	}

	if (cv & cv_volatile) {

		ENC_add_diag_volatile(bs);

	}

	ENC_diag_tq_null(bs);

	return (bs);

}

/*

    ENCODE A DIAGNOSTIC TYPE

    This routine adds the diagnostic information for the type t to the

    bitstream bs.  The type qualifiers are only output if qual is true.

*/

BITSTREAM *

enc_diag_type(BITSTREAM *bs, TYPE t, int qual)

{

	if (IS_NULL_type(t)) {

		ENC_diag_type_null(bs);

		return (bs);

	}

	if (qual) {

		/* Output type qualifier */

		CV_SPEC cv = DEREF_cv(type_qual(t));

		if (cv & cv_qual) {

			ENC_diag_loc(bs);

			bs = enc_diag_type(bs, t, 0);

			bs = enc_diag_type_qual(bs, cv);

			return (bs);

		}

	}

	ASSERT(ORDER_type == 18);

	switch (TAG_type(t)) {

	case type_integer_tag: {

		/* Integral types */

		ENC_diag_variety(bs);

		bs = enc_variety(bs, t);

		break;

	}

	case type_floating_tag: {

		/* Floating point types */

		ENC_diag_floating_variety(bs);

		bs = enc_flvar(bs, t);

		break;

	}

	case type_ptr_tag:

	case type_ref_tag: {

		/* Pointer types */

		TYPE s = DEREF_type(type_ptr_etc_sub(t));

		CV_SPEC cv = DEREF_cv(type_qual(s));

		ENC_diag_ptr(bs);

		bs = enc_diag_type(bs, s, 0);

		bs = enc_diag_type_qual(bs, cv);

		break;

	}

	case type_ptr_mem_tag: {

		/* Pointer to member types */

		int tok = TOK_pm_type;

		TYPE s = DEREF_type(type_ptr_mem_sub(t));

		if (IS_type_func(s)) {

			tok = TOK_pmf_type;

		}

		bs = enc_diag_special(bs, tok, VAR_diagtag);

		break;

	}

	case type_func_tag: {

		/* Function types */

		TYPE r = DEREF_type(type_func_ret(t));

		LIST(TYPE)p = DEREF_list(type_func_mtypes(t));

		int ell = DEREF_int(type_func_ellipsis(t));

		ENC_diag_proc(bs);

		ENC_LIST(bs, LENGTH_list(p));

		while (!IS_NULL_list(p)) {

			TYPE s = DEREF_type(HEAD_list(p));

			bs = enc_diag_type(bs, s, 0);

			p = TAIL_list(p);

		}

		bs = enc_bool(bs,(ell & FUNC_ELLIPSIS));

		bs = enc_diag_type(bs, r, 0);

		break;

	}

	case type_array_tag: {

		/* Array types */

		TYPE i = type_sint;

		TYPE s = DEREF_type(type_array_sub(t));

		NAT n = DEREF_nat(type_array_size(t));

		ENC_diag_array(bs);

		bs = enc_diag_type(bs, s, 0);

		bs = enc_shape_offset(bs, s);

		bs = enc_make_int(bs, i, 0);

		if (IS_NULL_nat(n)) {

			/* Empty array bound */

			bs = enc_make_int(bs, i, 0);

		} else {

			/* Calculated array bound */

			unsigned long v = get_nat_value(n);

			if (v < SMALL_ARRAY_BOUND) {

				/* Small value */

				if (v) {

					v--;

				}

				bs = enc_make_int(bs, i,(int)v);

			} else {

				ENC_minus(bs);

				bs = enc_error_treatment(bs, i);

				ENC_make_int(bs);

				bs = enc_variety(bs, i);

				bs = enc_snat(bs, n, 0, 1);

				bs = enc_make_int(bs, i, 1);

			}

		}

		bs = enc_diag_type(bs, i, 0);

		break;

	}

	case type_bitfield_tag: {

		/* Bitfield types */

		INT_TYPE bf = DEREF_itype(type_bitfield_defn(t));

		TYPE s = DEREF_type(itype_bitfield_sub(bf));

		NAT n = DEREF_nat(itype_bitfield_size(bf));

		ENC_diag_bitfield(bs);

		bs = enc_diag_type(bs, s, 0);

		bs = enc_nat(bs, n, 1);

		break;

	}

	case type_compound_tag: {

		/* Class types */

		CLASS_TYPE ct = DEREF_ctype(type_compound_defn(t));

		bs = enc_diag_ctype(bs, ct);

		break;

	}

	case type_enumerate_tag: {

		/* Enumeration types */

		ENUM_TYPE et = DEREF_etype(type_enumerate_defn(t));

		bs = enc_diag_etype(bs, et);

		break;

	}

	case type_token_tag: {

		/* Tokenised types */

		IDENTIFIER tok = DEREF_id(type_token_tok(t));

		LIST(TOKEN)args = DEREF_list(type_token_args(t));

		bs = enc_diag_tok_type(bs, tok, args);

		break;

	}

	default : {

		/* Other types */

		ENC_diag_type_null(bs);

		break;

	}

	}

	return (bs);

}

/*

    ENCODE DIAGNOSTICS FOR A TOKEN DEFINITION

    This routine outputs any diagnostic information for the token id

    to the appropriate diagnostic units.  It is only called if id is

    defined.  The type t may be used to override the type of id.

*/

void

enc_diag_token(IDENTIFIER id, TYPE t)

{

	TOKEN tok;

#if TDF_NEW_DIAG

	if (output_new_diag) {

		enc_dg_token(id, t);

		return;

	}

#endif

	tok = DEREF_tok(id_token_sort(id));

	if (IS_tok_type(tok)) {

		BASE_TYPE bt = DEREF_btype(tok_type_kind(tok));

		if (bt & btype_scalar) {

			/* Tokenised arithmetic types */

			/* EMPTY */

		} else {

			/* Tokenised generic types */

			BITSTREAM *bs;

			IDENTIFIER alt = DEREF_id(id_token_alt(id));

			DECL_SPEC ds = DEREF_dspec(id_storage(alt));

			ulong n = get_diag_tag(id, VAR_token);

			if (n == LINK_NONE) {

				/* Find external name */

				string s = mangle_name(id, VAR_diagtag, 0);

				n = capsule_no(s, VAR_diagtag);

				set_diag_tag(id, VAR_token, n);

			}

			bs = enc_diag_tagdef_start(n);

			if (IS_NULL_type(t)) {

				/* Extract type if not given */

				t = DEREF_type(tok_type_value(tok));

			}

			bs = enc_diag_type(bs, t, 0);

			enc_diag_tagdef_end(bs);

			if (!(ds & dspec_done)) {

				/* Output internal name */

				ds |= dspec_done;

				COPY_dspec(id_storage(alt), ds);

				enc_diag_id(alt, 1);

			}

		}

	}

	return;

}

/*

    ENCODE A GLOBAL DIAGNOSTIC IDENTIFIER

    This routine adds the diagnostic information for the global identifier

    id to the diagnostic definition unit.  def is true for a definition.

*/

void

enc_diag_id(IDENTIFIER id, int def)

{

	TYPE t;

	ulong n;

	BITSTREAM *bs = NULL;

#if TDF_NEW_DIAG

	if (output_new_diag) {

		enc_dg_id(id, def);

		return;

	}

#endif

	UNUSED(def);

	n = DEREF_ulong(id_no(id));

	switch (TAG_id(id)) {

	case id_class_alias_tag:

	case id_enum_alias_tag:

	case id_type_alias_tag: {

		/* Typedef names */

		t = DEREF_type(id_class_name_etc_defn(id));

		bs = start_bitstream(NIL(FILE), diagdef_unit->link);

		ENC_diag_desc_typedef(bs);

		bs = enc_diag_name(bs, id, 1);

		bs = enc_diag_loc(bs, id_loc(id));

		bs = enc_diag_type(bs, t, 1);

		break;

	}

	case id_variable_tag:

	case id_parameter_tag:

	case id_stat_member_tag: {

		/* Variable names */

		t = DEREF_type(id_variable_etc_type(id));

		goto diag_label;

	}

	case id_function_tag:

	case id_mem_func_tag:

	case id_stat_mem_func_tag: {

		/* Function names */

		t = DEREF_type(id_function_etc_type(id));

		goto diag_label;

	}

diag_label: {

		     bs = start_bitstream(NIL(FILE), diagdef_unit->link);

		     ENC_diag_desc_id(bs);

		     bs = enc_diag_name(bs, id, 1);

		     bs = enc_diag_loc(bs, id_loc(id));

		     ENC_obtain_tag(bs);

		     n = link_no(bs, n, VAR_tag);

		     ENC_make_tag(bs, n);

		     bs = enc_diag_type(bs, t, 1);

		     break;

	     }

	}

	if (bs) {

		count_item(bs);

		diagdef_unit = join_bitstreams(diagdef_unit, bs);

	}

	return;

}

/*

    ENCODE DIAGNOSTICS INITIALISATION FUNCTION

    This routine adds the diagnostic information for the initialisation

    or termination function named s with tag number n to the diagnostics

    definition unit.

*/

void

enc_diag_init(CONST char *s, ulong n, TYPE t)

{

	if (output_all) {

		string u = ustrlit(s);

		n = capsule_name(n, &u, VAR_tag);

		if (u) {

			n = capsule_name(n, &u, VAR_tag);

		}

	}

	if (output_diag && !output_new_diag) {

		BITSTREAM *bs = start_bitstream(NIL(FILE), diagdef_unit->link);

		ENC_diag_desc_id(bs);

		bs = enc_ustring(bs, ustrlit(s));

		bs = enc_diag_loc(bs, NULL_ptr(LOCATION));

		ENC_obtain_tag(bs);

		n = link_no(bs, n, VAR_tag);

		ENC_make_tag(bs, n);

		bs = enc_diag_type(bs, t, 0);