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


#include "config.h"
#include "producer.h"

#include <limits.h>

#include "fmm.h"
#include "msgcat.h"
#include "tdf_types.h"
#include "tdf_stream.h"
#include "tenapp.h"

#include "version.h"
#include "system.h"
#include "c_types.h"
#include "hashid_ops.h"
#include "id_ops.h"
#include "off_ops.h"
#include "type_ops.h"
#include "error.h"
#include "catalog.h"
#include "tdf.h"
#include "basetype.h"
#include "capsule.h"
#include "char.h"
#include "compile.h"
#include "diag2.h"
#include "encode.h"
#include "file.h"
#include "hash.h"
#include "mangle.h"
#include "struct.h"
#include "throw.h"
#include "tok.h"
#include "ustring.h"


/*
 *    START OF TDF OUTPUT ROUTINES
 *
 *    The compiler can optionally be compiled with the TDF output routines
 *    disabled by defining the TDF_OUTPUT macro to be zero on the
 *    command-line.  The following routines are concerned with TDF output.
 */

#if TDF_OUTPUT


/*
 *    TABLE OF TDF UNIT TYPES
 *
 *    This table gives the various TDF unit types (token definitions, tag
 *    declarations etc.).  These are called equations in the TDF linking
 *    routines.  Each entry consists of an equation name, a couple of
 *    flags indicating the unit structure, and a list of bitstreams giving
 *    the units of that type.  The entries correspond to the EQN macros
 *    defined in capsule.h.
 */

typedef struct {
	const char *name;
	int labels;
	int count;
	LIST (BITSTREAM_P) pres;
	LIST (BITSTREAM_P) units;
} EQN_INFO;

#define NO_EQNS		NULL_list (BITSTREAM_P)

static EQN_INFO eqns [EQN_no] = {
	{ LINK_tld_props, 0, 0, NO_EQNS, NO_EQNS },		/* EQN_tld */
	{ LINK_version_props, 0, 1, NO_EQNS, NO_EQNS },	/* EQN_versions */
	{ LINK_tokdec_props, 0, 1, NO_EQNS, NO_EQNS },	/* EQN_tokdec */
	{ LINK_tokdef_props, 1, 1, NO_EQNS, NO_EQNS },	/* EQN_tokdef */
	{ LINK_al_tagdef_props, 1, 1, NO_EQNS, NO_EQNS },	/* EQN_aldef */
	{ LINK_diag_type_unit, 1, 1, NO_EQNS, NO_EQNS },	/* EQN_diagtype */
	{ LINK_tagdec_props, 1, 1, NO_EQNS, NO_EQNS },	/* EQN_tagdec */
	{ LINK_diag_unit, 1, 1, NO_EQNS, NO_EQNS },		/* EQN_diagdef */
	{ LINK_dg_comp_props, 1, 1, NO_EQNS, NO_EQNS },	/* EQN_dgcomp */
	{ LINK_tagdef_props, 1, 1, NO_EQNS, NO_EQNS },	/* EQN_tagdef */
	{ LINK_linkinfo_props, 1, 1, NO_EQNS, NO_EQNS }	/* EQN_linkinfo */
};


/*
 *    TABLE OF LINKABLE TDF ENTITIES
 *
 *    This table gives the various TDF linkable entities (tokens, tags etc.).
 *    These are called variables in the TDF linking routines.  Each entry
 *    consists of a variable name and a table of capsule level variables
 *    of that type (the label entry being a dummy).  The entries correspond
 *    to the VAR macros defined in capsule.h.
 */

typedef struct {
	const char *name;
	ulong no;
	ulong sz;
	int present;
	string *names;
	unsigned char *uses;
	ulong *diags;
} VAR_INFO;

static VAR_INFO vars [VAR_total] = {
	{ LINK_tag, 0, 0, 0, NULL, NULL, NULL },		/* VAR_tag */
	{ LINK_token, 0, 0, 0, NULL, NULL, NULL },		/* VAR_token */
	{ LINK_al_tag, 0, 0, 0, NULL, NULL, NULL },		/* VAR_alignment */
	{ LINK_diag_tag, 0, 0, 0, NULL, NULL, NULL },	/* VAR_diagtag */
	{ LINK_dg_tag, 0, 0, 0, NULL, NULL, NULL },		/* VAR_dgtag */
	{ LINK_label, 0, 0, 0, NULL, NULL, NULL }		/* VAR_label */
};


/*
 *    TYPE REPRESENTING A UNIT LINKAGE
 *
 *    This type is used to represent the linkage for a unit.  It records the
 *    number of each variable type (plus labels) and the mapping of each of
 *    the external variables in this unit.  It also records a count value
 *    for the number of items in the unit when this is an explicitly
 *    created unit.
 */

typedef struct link_tag {
	ulong no [VAR_total];
	ulong no_map [VAR_no];
	ulong *map [VAR_no];
	ulong count;
	int create;
	struct link_tag *next;
} LINKAGE;


/*
 *    LIST OF ALL UNIT LINKAGES
 *
 *    A list of all unit linkages is maintained so that extending a list of
 *    external variables also extends all the unit linkage maps.
 */

static LINKAGE *all_links = NULL;


/*
 *    CREATE A NEW LINKAGE BITSTREAM
 *
 *    This routine starts a new bitstream ps and associates a linkage unit
 *    with it.
 */

static void
start_linkage(BITSTREAM **ps, int create)
{
	/* Allocate a linkage unit */
	int i;
	VAR_INFO *var = vars;
	LINKAGE *p = xmalloc (sizeof(*p));
	for (i = 0; i < VAR_no; i++) {
		ulong j, n = var->sz;
		if (n) {
			ulong *q = xmalloc_nof (ulong, n);
			for (j = 0; j < n; j++) q [j] = LINK_NONE;
			p->map [i] = q;
		} else {
			p->map [i] = NULL;
		}
		p->no [i] = 0;
		p->no_map [i] = 0;
		var++;
	}
	p->no [VAR_label] = 0;
	p->count = 0;
	p->create = create;
	p->next = all_links;
	all_links = p;

	/* Start TDF stream */
	*ps = tdf_bs_create (NULL, TDFS_MODE_WRITE, p);
	return;
}


/*
 *    EXTEND A VARIABLE LINKAGE TABLE
 *
 *    This routine extends the variable linkage table for variable type v.
 */

static void
extend_linkage(int v)
{
	ulong i;
	LINKAGE *q;
	VAR_INFO *var = vars + v;
	ulong m = var->sz;
	ulong n = m + 100;

	/* Extend global linkage table */
	string *s = var->names;
	unsigned char *u = var->uses;
	ulong *d = var->diags;
	s = xrealloc (s, sizeof(*s) * n);
	u = xrealloc (u, sizeof(*u) * n);
	if (output_diag && (v == VAR_tag || v == VAR_token)) {
		d = xrealloc (d, sizeof(*d) * n);
	}
	for (i = m; i < n; i++) {
		s [i] = NULL;
		u [i] = USAGE_NONE;
		if (d) d [i] = LINK_NONE;
	}
	var->sz = n;
	var->names = s;
	var->uses = u;
	var->diags = d;

	/* Extend each unit linkage table */
	for (q = all_links; q != NULL; q = q->next) {
		ulong *r = q->map [v];
		r = xrealloc (r, sizeof(*r) * n);
		for (i = m; i < n; i++) r [i] = LINK_NONE;
		q->map [v] = r;
	}
	return;
}


/*
 *    FIND AN EXTERNAL LINKAGE NUMBER
 *
 *    This routine allocates an external (capsule) linkage number for a
 *    variable of type v with external name s, returning the result.
 */

ulong
capsule_no(string s, int v)
{
	VAR_INFO *var = vars + v;
	ulong n = (var->no)++;
	if (n >= var->sz) extend_linkage (v);
	var->uses [n] = USAGE_USE;
	var->names [n] = s;
	var->present = 1;
	return (n | LINK_EXTERN);
}


/*
 *    SET AN EXTERNAL LINKAGE NAME
 *
 *    This routine sets the external name for the variable of type v with
 *    external linkage number n to be the contents of ps, allocating a new
 *    variable if n is LINK_NONE.  It returns the value of n and assigns
 *    the old variable name to ps.
 */

ulong
capsule_name(ulong n, string *ps, int v)
{
	string s = *ps;
	if (n == LINK_NONE) {
		n = capsule_no (s, v);
	} else {
		VAR_INFO *var = vars + v;
		ulong m = (n & ~LINK_EXTERN);
		ASSERT (n & LINK_EXTERN);
		*ps = var->names [m];
		var->names [m] = s;
	}
	return (n);
}


/*
 *    ASSIGN AN EXTERNAL LINKAGE NUMBER
 *
 *    This routine allocates an external (capsule) linkage number to the
 *    identifier id of variable type v.  It returns false if this number
 *    has already been allocated.  Note that id cannot be made external
 *    after it has been made internal.
 */

int
capsule_id(IDENTIFIER id, int v)
{
	int r;
	IDENTIFIER lid = DEREF_id (id_alias (id));
	ulong n = DEREF_ulong (id_no (lid));
	if (n == LINK_NONE) {
		/* Not yet given a number */
		string s = mangle_name (lid, v, LANGUAGE_C);
		n = capsule_no (s, v);
		COPY_ulong (id_no (lid), n);
		COPY_ulong (id_no (id), n);
		r = 1;
	} else {
		ASSERT (n & LINK_EXTERN);
		r = 0;
	}
	return (r);
}


/*
 *    FIND AN INTERNAL LINKAGE NUMBER
 *
 *    This routine allocates an internal (unit) linkage number in the unit
 *    corresponding to bs to the external (capsule) variable number n of
 *    type v.
 */

ulong
link_no(BITSTREAM *bs, ulong n, int v)
{
	LINKAGE *lnk = (LINKAGE *) bs->ts_link;
	ulong m = (n & ~LINK_EXTERN);
	n = lnk->map [v] [m];
	if (n == LINK_NONE) {
		/* Does not have unit number */
		n = (lnk->no [v])++;
		lnk->map [v] [m] = n;
		(lnk->no_map [v])++;
		vars [v].present = 1;
	}
	return (n);
}


/*
 *    ASSIGN AN INTERNAL LINKAGE NUMBER
 *
 *    This routine allocates an internal (unit) linkage number to the
 *    identifier id of variable type v within the unit corresponding to bs.
 *    v can denote a label.  The corresponding number is returned.  Note
 *    that unless id has previously been made external then it can be
 *    internal to at most one unit.
 */

ulong
unit_no(BITSTREAM *bs, IDENTIFIER id, int v, int def)
{
	ulong n;
	if (IS_NULL_id (id)) {
		/* Allow anonymous identifiers */
		LINKAGE *lnk = (LINKAGE *) bs->ts_link;
		n = (lnk->no [v])++;
		vars [v].present = 1;
	} else {
		IDENTIFIER lid = DEREF_id (id_alias (id));
		n = DEREF_ulong (id_no (lid));
		if (n == LINK_NONE) {
			/* Not yet given a number */
			LINKAGE *lnk = (LINKAGE *) bs->ts_link;
			n = (lnk->no [v])++;
			COPY_ulong (id_no (lid), n);
			COPY_ulong (id_no (id), n);
			vars [v].present = 1;
			if (!def) {
				/* Shouldn't happen */
				LOCATION loc;
				DEREF_loc (id_loc (id), loc);
				report (loc, ERR_token_scope (id));
			}
		} else {
			if (n == LINK_TOKDEF) {
				/* Recursively defined token */
				LOCATION loc;
				DEREF_loc (id_loc (id), loc);
				report (loc, ERR_token_recursive (id));
				n = last_params [DUMMY_token];
				COPY_ulong (id_no (id), n);
			}
			if (n & LINK_EXTERN) {
				/* Already has capsule number */
				n = link_no (bs, n, v);
			}
		}
	}
	return (n);
}


/*
 *    CLEAR AN IDENTIFIER LINKAGE
 *
 *    This routine clears the identifier linkage for id.
 */

void
clear_no(IDENTIFIER id)
{
	if (!IS_NULL_id (id)) {
		IDENTIFIER lid = DEREF_id (id_alias (id));
		DECL_SPEC ds = DEREF_dspec (id_storage (id));
		COPY_dspec (id_storage (id), (ds & ~dspec_done));
		COPY_ulong (id_no (id), LINK_NONE);
		if (!EQ_id (lid, id)) {
			ds = DEREF_dspec (id_storage (lid));
			COPY_dspec (id_storage (lid), (ds & ~dspec_done));
			COPY_ulong (id_no (lid), LINK_NONE);
		}
	}
	return;
}


/*
 *    SET A DIAGNOSTIC TAG NUMBER
 *
 *    This routine sets the diagnostic tag associated with external identifier
 *    id of type v to be m.
 */

void
set_diag_tag(IDENTIFIER id, int v, ulong m)
{
	ulong n = DEREF_ulong (id_no (id));
	if (n == LINK_NONE) {
		IGNORE capsule_id (id, v);
		CONS_id (id, pending_funcs, pending_funcs);
		n = DEREF_ulong (id_no (id));
	}
	n &= ~LINK_EXTERN;
	ASSERT (vars [v].diags);
	vars [v].diags [n] = m;
	return;
}


/*
 *    GET A DIAGNOSTIC TAG NUMBER
 *
 *    This routine gets the diagnostic tag associated with external identifier
 *    id of type v.
 */

ulong
get_diag_tag(IDENTIFIER id, int v)
{
	ulong n = DEREF_ulong (id_no (id));
	if (n == LINK_NONE) return (LINK_NONE);
	n &= ~LINK_EXTERN;
	ASSERT (vars [v].diags);
	return (vars [v].diags [n]);
}


/*
 *    FIND THE NUMBER OF LABELS IN A UNIT
 *
 *    This routine returns the number of labels in the unit corresponding
 *    to the bitstream bs.
 */

ulong
no_labels(BITSTREAM *bs)
{
	LINKAGE *lnk = (LINKAGE *) bs->ts_link;
	return (lnk->no [VAR_label]);
}


/*
 *    RECORD USAGE INFORMATION
 *
 *    This routine records the usage information u for the external variable
 *    of type v with number n.
 */

void
record_usage(ulong n, int v, unsigned u)
{
	ulong m = (n & ~LINK_EXTERN);
	unsigned char *pw = vars [v].uses + m;
	unsigned w = (unsigned) *pw;
	*pw = (unsigned char) (w | u);
	return;
}


/*
 *    FIND USAGE INFORMATION
 *
 *    This routine finds the usage information for the external variable of
 *    type v with number n.
 */

unsigned
find_usage(ulong n, int v)
{
	ulong m = (n & ~LINK_EXTERN);
	unsigned u = (unsigned) vars [v].uses [m];
	return (u);
}


/*
 *    CLEAR USAGE INFORMATION
 *
 *    This routine clears the usage information for the external variable
 *    of type v with number n.
 */

void
clear_usage(ulong n, int v)
{
	ulong m = (n & ~LINK_EXTERN);
	vars [v].uses [m] = USAGE_NONE;
	return;
}


/*
 *    INCREMENT A LINKAGE COUNTER
 *
 *    This routine increments the linkage counter associated with the
 *    bitstream bs.  This is used to keep track of the number of tag
 *    declarations, or similar, within a unit.
 */

void
count_item(BITSTREAM *bs)
{
	LINKAGE *lnk = (LINKAGE *) bs->ts_link;
	(lnk->count)++;
	return;
}


/*
 *    ADD A UNIT TO A CAPSULE
 *
 *    This routine adds the unit given by the bitstream bs to the list of
 *    units of type u.  If the associate unit count is zero then the unit
 *    is not added.
 */

static void
add_unit(int u, BITSTREAM *bs, BITSTREAM *ps)
{
	if (bs) {
		LINKAGE *lnk = (LINKAGE *) bs->ts_link;
		if (lnk == NULL || lnk->count || ps) {
			EQN_INFO *eqn = eqns + u;
			LIST (BITSTREAM_P) us = eqn->units;
			LIST (BITSTREAM_P) vs = eqn->pres;
			CONS_bits (bs, us, us);
			CONS_bits (ps, vs, vs);
			eqn->units = us;
			eqn->pres = vs;
		}
	}
	return;
}


/*
 *    STANDARD BITSTREAMS
 *
 *    These bitstreams represent standard units within the TDF capsule.
 */

BITSTREAM *tokdec_unit = NULL;
BITSTREAM *tokdef_unit = NULL;
BITSTREAM *aldef_unit = NULL;
BITSTREAM *tagdec_unit = NULL;
BITSTREAM *tagdef_unit = NULL;
BITSTREAM *linkinfo_unit = NULL;
BITSTREAM *diagdef_unit = NULL;
BITSTREAM *diagtype_unit = NULL;
BITSTREAM *diagcomp_unit = NULL;
static BITSTREAM *diagcomp_pre = NULL;
static int written_capsule = 0;


/*
 *    DYNAMIC INITIALISATION AND TERMINATION FUNCTIONS
 *
 *    These bitstreams are used to build up the bodies of the dynamic
 *    initialisation and termination functions.  A count of the number
 *    of statements in each is maintained.
 */

BITSTREAM *init_func = NULL;
BITSTREAM *term_func = NULL;
BITSTREAM *term_static_func = NULL;
ulong init_no = 0;
ulong term_no = 0;


/*
 *    CREATE A LINKER INFORMATION UNIT
 *
 *    This routine creates a linker information unit containing just a tld
 *    version number.  The usage information for the external variables is
 *    added at a subsequent stage.
 */

static BITSTREAM *
make_tld_unit(void)
{
	struct tdf_stream *bs = tdf_bs_create (NULL, TDFS_MODE_WRITE, NULL);
	ENC_INT (bs, 1);
	return (bs);
}


/*
 *    CREATE A VERSIONS UNIT
 *
 *    This routine creates a versions unit containing a single version
 *    which gives the TDF version number.
 */

static BITSTREAM *
make_version_unit(void)
{
	BITSTREAM *bs;
	start_linkage (&bs, 1);
	ENC_make_version (bs);
	bs = enc_version (bs);
	count_item (bs);
	if (output_all) {
		/* Output compiler version number */
		string vers = report_version (0);
		ENC_user_info (bs);
		ENC_make_string (bs);
		tdf_en_ustring (bs, vers);
		count_item (bs);
	}
	return (bs);
}


/*
 *    CREATE ALL CAPSULE UNITS
 *
 *    This routine creates or completes all the units comprising the TDF
 *    capsule.
 */

static void
make_capsule_units(void)
{
	BITSTREAM *bs;
	init_diag ();
	bs = make_version_unit ();
	add_unit (EQN_versions, bs, NULL);
	enc_dynamic_init ();
	add_unit (EQN_tokdec, tokdec_unit, NULL);
	add_unit (EQN_tokdef, tokdef_unit, NULL);
	add_unit (EQN_aldef, aldef_unit, NULL);
	add_unit (EQN_diagtype, diagtype_unit, NULL);
	add_unit (EQN_tagdec, tagdec_unit, NULL);
	add_unit (EQN_diagdef, diagdef_unit, NULL);
	add_unit (EQN_dgcomp, diagcomp_unit, diagcomp_pre);
	add_unit (EQN_tagdef, tagdef_unit, NULL);
	add_unit (EQN_linkinfo, linkinfo_unit, NULL);
	return;
}


/*
 *    WRITE AN EXTERNAL NAME
 *
 *    This routine writes the external name s to the bitstream bs.  Spaces
 *    are used to designate the components of unique identifiers.
 */

static BITSTREAM *
enc_name(BITSTREAM *bs, string s, int v)
{
	string t = s;
	unsigned u = 0;
	unsigned long n;
	for (;;) {
		t = ustrchr (t, ' ');
		u++;
		if (t == NULL) break;
		t++;
	}
	if (u == 1) {
		/* Simple identifiers */
		n = (unsigned long) ustrlen (s);
		if (v == VAR_tag && n > mangle_length) {
			n = mangle_length;
		}
		ENC_string_extern (bs);
		ENC_ALIGN (bs);
		ENC_IDENT (bs, s, n);
	} else {
		/* Unique identifiers */
		ENC_unique_extern (bs);
		ENC_ALIGN (bs);
		ENC_SLIST (bs, u);
		for (;;) {
			t = ustrchr (s, ' ');
			if (t == NULL) {
				n = (unsigned long) ustrlen (s);
				ENC_IDENT (bs, s, n);
				break;
			}
			n = (unsigned long) (t - s);
			ENC_IDENT (bs, s, n);
			s = t + 1;
		}
	}
	return (bs);
}


/*
 *    WRITE MAIN CAPSULE BODY
 *
 *    This routine writes the main body of the output TDF capsule to the
 *    bitstream bs.
 */

static BITSTREAM *
write_capsule_body(BITSTREAM *bs)
{
	int i, j;
	EQN_INFO *eqn;
	VAR_INFO *var;
	ulong no_eqns = 0;
	ulong no_vars = 0;
	BITSTREAM *ts, *to;

	/* Call capsule construction routines */
	make_capsule_units ();

	/* Count the number of variables */
	var = vars;
	for (i = 0; i < VAR_no; i++) {
		if (var->present) no_vars++;
		var++;
	}

	/* Construct linker information unit */
	if (no_vars) {
		ts = make_tld_unit ();
		add_unit (EQN_tld, ts, NULL);
	} else {
		ts = NULL;
	}
	to = ts;

	/* Count the number of equations */
	eqn = eqns;
	for (i = 0; i < EQN_no; i++) {
		if (!IS_NULL_list (eqn->units)) no_eqns++;
		eqn++;
	}

	/* Output the equation names */
	eqn = eqns;
	ENC_SLIST (bs, no_eqns);
	for (i = 0; i < EQN_no; i++) {
		if (!IS_NULL_list (eqn->units)) {
			string s = ustrlit (eqn->name);
			ENC_IDENT (bs, s, ustrlen (s));
		}
		eqn++;
	}

	/* Output the variable names and numbers */
	var = vars;
	ENC_SLIST (bs, no_vars);
	for (i = 0; i < VAR_no; i++) {
		if (var->present) {
			string s = ustrlit (var->name);
			ENC_IDENT (bs, s, ustrlen (s));
			ENC_INT (bs, var->no);
		}
		var++;
	}

	/* Output the external variable identifiers */
	var = vars;
	ENC_SLIST (bs, no_vars);
	for (i = 0; i < VAR_no; i++) {
		if (var->present) {
			ulong no_ext = 0;
			ulong k, n = var->no;
			string *names = var->names;
			unsigned char *uses = var->uses;
			for (k = 0; k < n; k++) {
				string s = names [k];
				unsigned use = (unsigned) uses [k];
				if (use != USAGE_NONE) {
					const char *msg;
					if (s) {
						/* Count number of external names */
						no_ext++;
					} else {
						if (!(use & USAGE_DEFN)) {
							/* Undefined internal object */
							if ((use & USAGE_DECL) && i == VAR_dgtag) {
								/* Diagnostic tags can just be declared */
								use |= USAGE_DEFN;
							} else {
								msg = "'%s %lu' used but not defined";
								error (ERROR_INTERNAL, msg, var->name, k);
								use |= USAGE_DECL;
								names [k] = mangle_anon ();
								no_ext++;
							}
							uses [k] = (unsigned char) use;
						}
					}
					if (i == VAR_tag && !(use & USAGE_DECL)) {
						/* Undeclared tag */
						if (s) {
							msg = "'%s' used but not declared";
							error (ERROR_INTERNAL, msg, strlit (s));
						} else {
							msg = "'%s %lu' used but not declared";
							error (ERROR_INTERNAL, msg, var->name, k);
						}
					}
				} else {
					names [k] = NULL;
				}
			}
			ENC_SLIST (bs, no_ext);
			for (k = 0; k < n; k++) {
				string s = names [k];
				if (s) {
					unsigned use = (unsigned) uses [k];
					if (use & USAGE_COMMON) {
						/* Common subsumes defined */
						if (use & USAGE_DEFN) {
							use &= ~USAGE_DEFN;
						} else {
							use &= ~USAGE_COMMON;
						}
					}
					ENC_INT (ts, use);
					ENC_INT (bs, k);
					bs = enc_name (bs, s, i);
				}
			}
		}
		var++;
	}

	/* Update linker information unit */
	if (ts != to) {
		LIST (BITSTREAM_P) u = eqns [EQN_tld].units;
		u = END_list (u);
		COPY_bits (HEAD_list (u), ts);
	}

	/* Output the equation units */
	eqn = eqns;
	ENC_SLIST (bs, no_eqns);
	for (i = 0; i < EQN_no; i++) {
		int labels = eqn->labels;
		int count = eqn->count;
		LIST (BITSTREAM_P) u = eqn->units;
		if (!IS_NULL_list (u)) {
			/* Output list of units */
			LIST (BITSTREAM_P) v = eqn->pres;
			unsigned no_units = LENGTH_list (u);
			if (no_units > 1) {
				u = REVERSE_list (u);
				eqn->units = u;
			}
			ENC_SLIST (bs, no_units);
			while (!IS_NULL_list (u)) {
				unsigned ub;
				BITSTREAM *us = DEREF_bits (HEAD_list (u));
				BITSTREAM *vs = DEREF_bits (HEAD_list (v));
				void *plnk = us->ts_link;

				/* Output linkage information */
				if (plnk) {
					/* Output numbers of local variables */
					LINKAGE *lnk = (LINKAGE *) plnk;
					var = vars;
					ENC_SLIST (bs, no_vars);
					for (j = 0; j < VAR_no; j++) {
						if (var->present) {
							ulong nj = lnk->no [j];
							ENC_INT (bs, nj);
						}
						var++;
					}

					/* Output links for local variables */
					ENC_SLIST (bs, no_vars);
					var = vars;
					for (j = 0; j < VAR_no; j++) {
						if (var->present) {
							ulong k, n = vars [j].no;
							ulong *map = lnk->map [j];
							ulong no_map = lnk->no_map [j];
							ENC_SLIST (bs, no_map);
							for (k = 0; k < n; k++) {
								ulong nk = map [k];
								if (nk != LINK_NONE) {
									ENC_INT (bs, nk);
									ENC_INT (bs, k);
								}
							}
						}
						var++;
					}

					/* Add extra information to unit */
					if (lnk->create && (labels || count || vs)) {
						BITSTREAM *ws;
						ws = tdf_bs_create (NULL, TDFS_MODE_WRITE, plnk);
						if (labels) {
							/* Number of labels */
							ulong no_labs = lnk->no [VAR_label];
							ENC_INT (ws, no_labs);
						}
						ws = tdf_en_stream (ws, vs);
						if (count) {
							/* Number of items */
							ulong no_item = lnk->count;
							ENC_SLIST (ws, no_item);
						}
						us = tdf_en_stream (ws, us);
					}

				} else {
					/* No linkage information */
					ENC_SLIST_SMALL (bs, 0);
					ENC_SLIST_SMALL (bs, 0);
				}

				/* Add unit bitstream to capsule */
				ENC_ALIGN (us);
				ub = us->ts_pos;
				ENC_LENGTH (bs, tdf_pos_offset(ub));
				ENC_ALIGN (bs);
				(void)tdf_en_stream (bs, us);
				v = TAIL_list (v);
				u = TAIL_list (u);
			}
		}
		eqn++;
	}
	return (bs);
}


/*
 *    CURRENT FUNCTION INFORMATION
 *
 *    At the start of each function definition the associated class type
 *    and the identifier corresponding to the this parameter are recorded
 *    in these variables.
 */

CLASS_TYPE last_class = NULL_ctype;
ulong last_params [DUMMY_max];
int last_conts [DUMMY_max];


/*
 *    CLEAR FUNCTION INFORMATION
 *
 *    This routine clears the function information above.
 */

void
clear_params(void)
{
	int n;
	for (n = 0; n < DUMMY_max; n++) {
		last_params [n] = LINK_NONE;
		last_conts [n] = 0;
	}
	return;
}


/*
 *    INITIALISE OUTPUT ROUTINES
 *
 *    This routine initialises the TDF capsule output routines.
 */

void
init_capsule(void)
{
	if (output_capsule) {
		/* Initialise capsule units */
		HASHID nm;
		void *lnk;
		if (output_tokdec || output_all) {
			start_linkage (&tokdec_unit, 1);
			output_tokdec = 1;
		}
		start_linkage (&tokdef_unit, 1);
		start_linkage (&aldef_unit, 1);
		start_linkage (&tagdec_unit, 1);
		start_linkage (&tagdef_unit, 1);
		start_linkage (&linkinfo_unit, 1);
		if (output_diag) {
			start_linkage (&diagdef_unit, 1);
			start_linkage (&diagtype_unit, 1);
			start_linkage (&diagcomp_unit, 1);
			output_inline = 0;
			output_unused = 1;
		}
		written_capsule = 0;

		/* Initialise special functions */
		clear_params ();
		lnk = tagdef_unit->ts_link;
		init_func = tdf_bs_create (NULL, TDFS_MODE_WRITE, lnk);
		term_func = tdf_bs_create (NULL, TDFS_MODE_WRITE, lnk);
		term_static_func = tdf_bs_create (NULL, TDFS_MODE_WRITE, lnk);
		init_no = 0;
		term_no = 0;

		/* Initialise dummy types */
		MAKE_type_compound (cv_none, NULL_ctype, dummy_class);
		MAKE_type_ptr (cv_none, dummy_class, ptr_dummy_class);
		MAKE_type_dummy (cv_none, TOK_destr_type, dummy_count);
		MAKE_type_dummy (cv_none, TOK_vtab_type, dummy_vtab);
		MAKE_type_ptr (cv_none, dummy_vtab, ptr_dummy_vtab);
		MAKE_type_func (cv_none, type_sint, NULL_list (TYPE), 0,
						cv_lang, NULL_list (TYPE), NULL_nspace,
						NULL_list (IDENTIFIER), NULL_list (TYPE),
						dummy_func);
		MAKE_off_type (type_size_t, off_size_t);
		nm = lookup_anon ();
		dummy_type_name = DEREF_id (hashid_id (nm));
	}
	return;
}


/*
 *    INITIALISE DIAGNOSTIC ROUTINES
 *
 *    This routine is called at the start of each input file to initialise
 *    the diagnostic routines.
 */

void
init_diag(void)
{
#if TDF_NEW_DIAG
	if (output_capsule && output_diag >= 2) {
		BITSTREAM *bs = diagcomp_pre;
		if (bs == NULL) {
			bs = tdf_bs_create (NULL, TDFS_MODE_WRITE, diagcomp_unit->ts_link);
			bs = enc_dg_compilation (bs);
			diagcomp_pre = bs;
			output_new_diag = output_diag;
		}
	}
#endif
	return;
}


/*
 *    START OF DUMMY TDF OUTPUT ROUTINES
 *
 *    The following routines are dummies which are used if TDF output is
 *    disabled.  The output is still a valid TDF capsule, it just contains
 *    no information.
 */

#else /* TDF_OUTPUT */


/*
 *    WRITE MAIN CAPSULE BODY (DUMMY VERSION)
 *
 *    This routine writes the main body of a dummy TDF capsule to the
 *    bitstream bs.
 */

static BITSTREAM *
write_capsule_body(BITSTREAM *bs)
{
	return (bs);
}


/*
 *    INITIALISE OUTPUT ROUTINES (DUMMY VERSION)
 *
 *    This is the dummy initialisation routine for when the TDF output
 *    routines are disabled.
 */

void
init_capsule(void)
{
	output_capsule = 0;
	return;
}


/*
 *    INITIALISEE DIAGNOSTIC ROUTINES (DUMMY VERSION)
 *
 *    This is the dummy diagnostic initialisation routine for when the TDF
 *    output routines are disabled.
 */

void
init_diag(void)
{
	return;
}


/*
 *    END OF TDF OUTPUT ROUTINES
 *
 *    The remaining routines in this module are common whether TDF output
 *    is disabled or not.
 */

#endif /* TDF_OUTPUT */


/*
 *    TDF OUTPUT FLAGS
 *
 *    The flag output_capsule can be set to false to suppress TDF output.
 *    The other flags inhibit the output of other optional features.
 */

int output_tdf = 1;
int output_capsule = 1;
int output_all = 0;
int output_bugs = 0;
int output_builtin = 0;
int output_date = 1;
int output_diag = 0;
int output_except = 1;
int output_init = 0;
int output_inline = 0;
int output_new_diag = 0;
int output_order = 0;
int output_partial = 1;
int output_rtti = 1;
int output_shared = 1;
int output_std = 0;
int output_term = 0;
int output_tokdec = 0;
int output_unused = 1;
int output_virtual = 0;


/*
 *    PROCESS A TDF OUTPUT OPTION
 *
 *    This routine processes the TDF output options given by opt.  This
 *    corresponds to the command-line option '-jopt'.
 */

void
output_option(string opt)
{
	int out = 1;
	character c;
	while (c = *(opt++), c != 0) {
		switch (c) {
		case 'a' : output_all = out; break;
		case 'b' : output_bugs = out; break;
		case 'c' : output_capsule = out; break;
		case 'd' : output_term = out; break;
		case 'e' : output_except = out; break;
		case 'f' : mangle_signature = out; break;
		case 'g' : output_diag = (DIAG_VERSION * out); break;
		case 'h' : output_builtin = out; break;
		case 'i' : output_init = out; break;
		case 'j' : output_inline = out; break;
		case 'l' : output_std = out; break;
		case 'm' : output_date = out; break;
		case 'n' : mangle_objects = out; break;
		case 'o' : output_order = out; break;
		case 'p' : output_partial = out; break;
		case 'r' : output_rtti = out; break;
		case 's' : output_shared = out; break;
		case 't' : output_tokdec = out; break;
		case 'u' : output_unused = out; break;
		case 'v' : output_virtual = out; break;
		case '+' : out = 1; break;
		case '-' : out = 0; break;
		default : {
			/* Unknown output options */
			const char *err = "Unknown output option, '%c'";
			error (ERROR_WARNING, err, (int) c);
			break;
		}
		}
	}
	return;
}


/*
 *    ENCODE A VERSION NUMBER
 *
 *    This routine adds the TDF version number to the bitstream bs, making
 *    adjustments to the minor version number if the extensions they
 *    represent are not used.
 */

BITSTREAM *
enc_version(BITSTREAM *bs)
{
	int v = TDF_minor;
#if (TDF_major == 4 && TDF_minor == 1)
	if (!output_new_diag) v = 0;
#endif
	ENC_INT (bs, TDF_major);
	ENC_INT (bs, v);
	return (bs);
}


/*
 *    MAIN TDF OUTPUT ROUTINE
 *
 *    This routine outputs the TDF capsule built up by the parsing and
 *    construction routines.
 */

void
write_capsule(void)
{
	if (output_tdf && !written_capsule) {
		/* Open the output file */
		FILE *f;
		BITSTREAM *bs;
		written_capsule = 1;
		if (!open_output (OUTPUT_TDF, binary_mode)) {
			string nm = output_name [OUTPUT_TDF];
			fail (ERR_fail_output (nm));
			tenapp_exit ();
			return;
		}
		f = output_file [OUTPUT_TDF];
		bs = tdf_bs_create (f, TDFS_MODE_WRITE, NULL);

		/* Encode the magic number (4.0 and later) */
		ASSERT (TDF_VERSION == 100 * TDF_major + TDF_minor);
#if (TDF_major >= 4)
		ENC_BITS (bs, 8, ascii_T);
		ENC_BITS (bs, 8, ascii_D);
		ENC_BITS (bs, 8, ascii_F);
		ENC_BITS (bs, 8, ascii_C);
		bs = enc_version (bs);
		ENC_ALIGN (bs);
#endif

		/* Encode the main capsule body */
		if (output_capsule) {
			bs = write_capsule_body (bs);
		} else {
			ENC_SLIST_SMALL (bs, 0);
			ENC_SLIST_SMALL (bs, 0);
			ENC_SLIST_SMALL (bs, 0);
			ENC_SLIST_SMALL (bs, 0);
		}
		tdf_en_align(bs);
		tdf_stream_destroy (bs);
		close_output (OUTPUT_TDF);
	}
	return;
}
