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 <limits.h>

#include "system.h"

#include "version.h"

#include "c_types.h"

#include "err_ext.h"

#include "ctype_ops.h"

#include "etype_ops.h"

#include "exp_ops.h"

#include "ftype_ops.h"

#include "graph_ops.h"

#include "hashid_ops.h"

#include "id_ops.h"

#include "itype_ops.h"

#include "nat_ops.h"

#include "nspace_ops.h"

#include "tok_ops.h"

#include "type_ops.h"

#include "error.h"

#include "catalog.h"

#include "basetype.h"

#include "buffer.h"

#include "char.h"

#include "constant.h"

#include "convert.h"

#include "dump.h"

#include "exception.h"

#include "file.h"

#include "function.h"

#include "lex.h"

#include "literal.h"

#include "macro.h"

#include "mangle.h"

#include "print.h"

#include "statement.h"

#include "token.h"

#include "ustring.h"

#include "xalloc.h"

/*

    DUMP FILE OPTIONS

    These variables give the various dump file options.

*/

int do_dump = 0;

int do_error = 0;

int do_header = 0;

int do_keyword = 0;

int do_local = 0;

int do_macro = 0;

int do_scope = 0;

int do_string = 0;

int do_usage = 0;

/*

    DUMP FILE VARIABLES

    These variables give the dump file and the associated dump buffer.

*/

static FILE *dump_file = NULL;

static BUFFER dump_buff_rep = NULL_buff;

static BUFFER *dump_buff = &dump_buff_rep;

/*

    DUMP BUFFER TO FILE

    This routine adds the contents of the dump buffer to the dump file.

*/

static void

dump_string(void)

{

	FILE *f = dump_file;

	BUFFER *bf = dump_buff;

	string s = bf->start;

	size_t n = (size_t)(bf->posn - s);

	fprintf_v(f, "&%lu<",(unsigned long)n);

	if (n) {

		IGNORE fwrite((gen_ptr)s, sizeof(character), n, f);

		bf->posn = s;

	}

	fputc_v('>', f);

	return;

}

/*

    FORWARD DECLARATIONS

    The dump routines defined in this module are defined recursively

    so a couple of forward declarations are required.

*/

static void dump_id(IDENTIFIER);

static void dump_type(TYPE);

static void dump_tok_appl(IDENTIFIER, LIST(TOKEN));

static void dump_nat(NAT, int);

/*

    DUMP FLAGS

    The flag dump_implicit can be set to true to indicate that the

    following declaration or definition is actually implicit.  The flag

    dump_anon_class can be set to inhibit type definitions which name

    anonymous classes being output twice.

*/

int dump_implicit = 0;

int dump_template = 0;

int dump_anon_class = 0;

/*

    FIND AN IDENTIFIER KEY

    This routine finds the key corresponding to the identifier id.

    This is a sequence of characters giving the type of identifier.

*/

static CONST char *

dump_key(IDENTIFIER id, int def)

{

	CONST char *key = NULL;

	if (do_dump && !IS_NULL_id(id)) {

		switch (TAG_id(id)) {

		case id_keyword_tag:

		case id_iso_keyword_tag: {

			/* Keywords */

			key = "K";

			break;

		}

		case id_obj_macro_tag: {

			/* Object-like macros */

			DECL_SPEC ds = DEREF_dspec(id_storage(id));

			if (ds & dspec_builtin) {

				key = "MB";

			} else {

				key = "MO";

			}

			break;

		}

		case id_func_macro_tag: {

			/* Function-like macros */

			key = "MF";

			break;

		}

		case id_builtin_tag: {

			/* Built-in functions */

			key = "FB";

			break;

		}

		case id_class_name_tag: {

			/* Classes, structures and unions */

			CLASS_TYPE ct;

			CLASS_INFO ci;

			TYPE t = DEREF_type(id_class_name_defn(id));

			while (IS_type_templ(t)) {

				t = DEREF_type(type_templ_defn(t));

			}

			ct = DEREF_ctype(type_compound_defn(t));

			ci = DEREF_cinfo(ctype_info(ct));

			if (ci & cinfo_union) {

				key = "TU";

			} else if (ci & cinfo_struct) {

				key = "TS";

			} else {

				key = "TC";

			}

			break;

		}

		case id_enum_name_tag: {

			/* Enumerations */

			key = "TE";

			break;

		}

		case id_class_alias_tag:

		case id_enum_alias_tag:

		case id_type_alias_tag: {

			/* Type aliases */

			if (dump_anon_class) {

				dump_anon_class = 0;

			} else {

				key = "TA";

			}

			break;

		}

		case id_nspace_name_tag: {

			/* Namespaces */

			key = "NN";

			break;

		}

		case id_nspace_alias_tag: {

			/* Namespace aliases */

			key = "NA";

			break;

		}

		case id_variable_tag: {

			/* Variables */

			DECL_SPEC ds = DEREF_dspec(id_storage(id));

			if (ds & dspec_auto) {

				if (do_local) {

					key = "VA";

				}

			} else if (ds & dspec_static) {

				key = "VS";

			} else {

				key = "VE";

			}

			break;

		}

		case id_parameter_tag:

		case id_weak_param_tag: {

			/* Function parameters */

			if (def && do_local) {

				key = "VP";

			}

			break;

		}

		case id_function_tag: {

			/* Functions */

			static char f[10];

			char *fp = f;

			DECL_SPEC ds = DEREF_dspec(id_storage(id));

			*(fp++) = 'F';

			if (ds & dspec_static) {

				*(fp++) = 'S';

			} else {

				*(fp++) = 'E';

			}

			if (ds & dspec_c) {

				*(fp++) = 'C';

			}

			if (ds & dspec_inline) {

				*(fp++) = 'I';

			}

			*fp = 0;

			key = f;

			break;

		}

		case id_mem_func_tag: {

			/* Member functions */

			DECL_SPEC ds = DEREF_dspec(id_storage(id));

			if (!(ds & dspec_trivial)) {

				if (ds & dspec_virtual) {

					key = "CV";

				} else {

					key = "CF";

				}

			}

			break;

		}

		case id_stat_mem_func_tag: {

			/* Static member functions */

			key = "CS";

			break;

		}

		case id_stat_member_tag: {

			/* Static data members */

			key = "CD";

			break;

		}

		case id_member_tag: {

			/* Data members */

			key = "CM";

			break;

		}

		case id_enumerator_tag: {

			/* Enumerators */

			key = "E";

			break;

		}

		case id_label_tag: {

			/* Labels */

			key = "L";

			break;

		}

		case id_token_tag: {

			/* Tokens */

			DECL_SPEC ds = DEREF_dspec(id_storage(id));

			if (ds & dspec_auto) {

				if (ds & dspec_template) {

					key = "XT";

				} else {

					key = "XP";

				}

			} else {

				TOKEN tok = DEREF_tok(id_token_sort(id));

				if (!IS_NULL_tok(tok) && IS_tok_proc(tok)) {

					key = "XF";

				} else {

					key = "XO";

				}

			}

			break;

		}

		}

	}

	return (key);

}

/*

    DUMP A LEXICAL TOKEN

    This routine adds the lexical token t to the dump file.

*/

static void

dump_lex(int t)

{

	FILE *f = dump_file;

	string s = token_name(t);

	if (s) {

		unsigned n = (unsigned)ustrlen(s);

		if (n > 100 || ustrchr(s, '>')) {

			fprintf_v(f, "&%u", n);

		}

		fprintf_v(f, "<%s>", strlit(s));

	} else {

		fputs_v("<>", f);

	}

	return;

}

/*

    DUMP A HASH TABLE ENTRY

    This routine adds the hash table entry nm to the dump file.

*/

static void

dump_hashid(HASHID nm)

{

	FILE *f = dump_file;

	if (IS_NULL_hashid(nm)) {

		fputs_v("<>", f);

		return;

	}

	switch (TAG_hashid(nm)) {

	case hashid_name_tag:

	case hashid_ename_tag: {

		/* Simple identifiers */

		string s = DEREF_string(hashid_name_etc_text(nm));

		unsigned n = (unsigned)ustrlen(s);

		if (n > 100 || ustrchr(s, '>')) {

			fprintf_v(f, "&%u", n);

		}

		fprintf_v(f, "<%s>", strlit(s));

		break;

	}

	case hashid_constr_tag: {

		/* Constructor names */

		TYPE t = DEREF_type(hashid_constr_type(nm));

		fputc_v('C', f);

		dump_type(t);

		break;

	}

	case hashid_destr_tag: {

		/* Destructor names */

		TYPE t = DEREF_type(hashid_destr_type(nm));

		fputc_v('D', f);

		dump_type(t);

		break;

	}

	case hashid_conv_tag: {

		/* Conversion function names */

		TYPE t = DEREF_type(hashid_conv_type(nm));

		fputc_v('T', f);

		dump_type(t);

		break;

	}

	case hashid_op_tag: {

		/* Overloaded operator names */

		int t = DEREF_int(hashid_op_lex(nm));

		fputc_v('O', f);

		dump_lex(t);

		break;

	}

	default : {

		/* Other names */

		fputs_v("<>", f);

		break;

	}

	}

	return;

}

/*

    DUMP A NAMESPACE

    This routine adds the namespace ns to the dump file.  The current

    declaration block is taken into account in blk is true.

*/

static void

dump_nspace(NAMESPACE ns, int blk)

{

	if (!IS_NULL_nspace(ns)) {

		if (blk) {

			LIST(IDENTIFIER)s;

			s = LIST_stack(DEREF_stack(nspace_set(ns)));

			if (!IS_NULL_list(s)) {

				/* Allow for declaration blocks */

				IDENTIFIER id = DEREF_id(HEAD_list(s));

				dump_id(id);

				return;

			}

		}

		if (!IS_nspace_global(ns)) {

			ulong n = DEREF_ulong(nspace_dump(ns));

			if (n == LINK_NONE) {

				IDENTIFIER id = DEREF_id(nspace_name(ns));

				if (!IS_NULL_id(id)) {

					/* Use namespace name */

					dump_id(id);

					n = DEREF_ulong(id_dump(id));

					COPY_ulong(nspace_dump(ns), n);

					return;

				}

			} else {

				/* Already assigned value */

				fprintf_v(dump_file, "%lu", n);

				return;

			}

		}

	}

	fputs_v("*", dump_file);

	return;

}

/*

    DUMP AN ACCESS SPECIFIER

    This routine adds the access specifier acc to the dump file.

*/

static void

dump_access(DECL_SPEC acc)

{

	DECL_SPEC ds = (acc & dspec_access);

	if (ds == dspec_private) {

		fputc_v('P', dump_file);

	} else if (ds == dspec_protected) {

		fputc_v('B', dump_file);

	}

	return;

}

/*

    IDENTIFIER DUMP NUMBER

    Each identifier dumped is assigned a number in a sequence given

    by this variable.  The zero value stands for the null identifier.

*/

ulong dump_id_next = 1;

/*

    DUMP AN IDENTIFIER

    This routine adds the identifier id to the dump file.

*/

static void

dump_id(IDENTIFIER id)

{

	if (IS_NULL_id(id)) {

		fputs_v("0", dump_file);

	} else {

		ulong n = DEREF_ulong(id_dump(id));

		if (n == LINK_NONE || (n & LINK_EXTERN)) {

			FILE *f = dump_file;

			HASHID nm = DEREF_hashid(id_name(id));

			NAMESPACE ns = DEREF_nspace(id_parent(id));

			DECL_SPEC acc = DEREF_dspec(id_storage(id));

			if (n == LINK_NONE) {

				/* Allocate new number */

				n = dump_id_next++;

			} else {

				/* Use number from spec file */

				n &= ~LINK_EXTERN;

			}

			COPY_ulong(id_dump(id), n);

			fprintf_v(f, "%lu = ", n);

			dump_hashid(nm);

			fputc_v('\t', f);

			dump_access(acc);

			dump_nspace(ns, 1);

		} else {

			fprintf_v(dump_file, "%lu", n);

		}

	}

	return;

}

/*

    LAST DUMP LOCATION

    When dumping locations the previous location is stored in these

    variables and only items which have changed are output.

*/

static unsigned long last_ln = 0;

static unsigned long last_cn = 0;

static string last_file = NULL;

static string last_input = NULL;

static PTR(POSITION)last_posn = NULL_ptr(POSITION);

/*

    DUMP A LOCATION

    This routine adds the location loc to the dump file.

*/

static void

dump_loc(LOCATION *loc)

{

	FILE *f = dump_file;

	unsigned long ln = loc->line;

	unsigned long cn = loc->column;

	PTR(POSITION)posn = loc->posn;

	if (EQ_ptr(posn, last_posn)) {

		/* Same file information as previously */

		if (ln == last_ln) {

			if (cn == last_cn) {

				fputs_v("*", f);

			} else {

				fprintf_v(f, "%lu\t*", cn);

				last_cn = cn;

			}

		} else {

			fprintf_v(f, "%lu\t%lu\t*", cn, ln );

			last_cn = cn;

			last_ln = ln;

		}

	} else {

		/* Different file information */

		string file = DEREF_string(posn_file(posn));

		string input = DEREF_string(posn_input(posn));

		unsigned long off = DEREF_ulong(posn_offset(posn));

		fprintf_v(f, "%lu\t%lu\t%lu\t", cn, ln, ln - off );

		if (ustreq(file, last_file) && ustreq(input, last_input)) {

			/* File names unchanged */

			fputc_v('*', f);

		} else {

			unsigned n = (unsigned)ustrlen(file);

			fprintf_v(f, "&%u<%s>\t", n, strlit(file));

			if (ustreq(file, input)) {

				/* Current and actual files match */

				fputc_v('*', f);

			} else {

				/* Different current and actual files */

				n = (unsigned)ustrlen(input);

				fprintf_v(f, "&%u<%s>", n, strlit(input));

			}

			last_input = input;

			last_file = file;

		}

		last_posn = posn;

		last_cn = cn;

		last_ln = ln;

	}

	return;

}

/*

    DUMP AN EXPRESSION

    This routine adds the expression e to the dump file.

*/

static void

dump_exp(EXP e)

{

	if (!IS_NULL_exp(e)) {

		switch (TAG_exp(e)) {

		case exp_int_lit_tag: {

			/* Integer literals */

			NAT n = DEREF_nat(exp_int_lit_nat(e));

			dump_nat(n, 0);

			return;

		}

		case exp_token_tag: {

			/* Tokenised expressions */

			IDENTIFIER id = DEREF_id(exp_token_tok(e));

			LIST(TOKEN)args = DEREF_list(exp_token_args(e));

			dump_tok_appl(id, args);

			return;

		}

		}

	}

	IGNORE print_exp(e, 0, dump_buff, 0);

	dump_string();

	return;

}

/*

    DUMP AN OFFSET

    This routine adds the offset off to the dump file.

*/

static void

dump_off(OFFSET off)

{

	IGNORE print_offset(off, dump_buff, 0);

	dump_string();

	return;

}

/*

    DUMP AN INTEGER CONSTANT

    This routine adds the integer constant n to the dump file.

*/

static void

dump_nat(NAT n, int neg)

{

	if (!IS_NULL_nat(n)) {

		FILE *f = dump_file;

		ASSERT(ORDER_nat == 5);

		switch (TAG_nat(n)) {

		case nat_small_tag: {

			/* Small literals */

			unsigned v = DEREF_unsigned(nat_small_value(n));

			int s = (neg ? '-' : '+');

			fputc_v(s, f);

			fprintf_v(f, "%u", v);

			break;

		}

		case nat_large_tag: {

			/* Large literals */

			unsigned long v = get_nat_value(n);

			int s = (neg ? '-' : '+');

			fputc_v(s, f);

			fprintf_v(f, "%lu", v);

			break;

		}

		case nat_neg_tag: {

			/* Negated literals */

			NAT m = DEREF_nat(nat_neg_arg(n));

			dump_nat(m, !neg);

			break;

		}

		case nat_calc_tag: {

			/* Calculated literals */

			EXP e = DEREF_exp(nat_calc_value(n));

			dump_exp(e);

			break;

		}

		case nat_token_tag: {

			/* Tokenised literals */

			IDENTIFIER id = DEREF_id(nat_token_tok(n));

			LIST(TOKEN)args = DEREF_list(nat_token_args(n));

			dump_tok_appl(id, args);

			break;

		}

		}

	}

	return;

}

/*

    DUMP A LIST OF TOKEN PARAMETERS

    This routine adds the list of token parameters pids to the dump file.

*/

static void

dump_params(LIST(IDENTIFIER)pids)

{

	int started = 0;

	FILE *f = dump_file;

	while (!IS_NULL_list(pids)) {

		IDENTIFIER pid = DEREF_id(HEAD_list(pids));

		if (!IS_NULL_id(pid)) {

			if (IS_id_token(pid)) {

				pid = DEREF_id(id_token_alt(pid));

			}

			if (started) {

				fputc_v(MANGLE_comma, f);

			}

			dump_id(pid);

			started = 1;

		}

		pids = TAIL_list(pids);

	}

	return;

}

/*

    DUMP A TOKEN SORT

    This routine adds the token sort tok to the dump file.

*/

static void

dump_sort(TOKEN tok)

{

	FILE *f = dump_file;

	ASSERT(ORDER_tok == 10);

	switch (TAG_tok(tok)) {

	case tok_exp_tag: {

		/* Expression tokens */

		TYPE t = DEREF_type(tok_exp_type(tok));

		int c = DEREF_int(tok_exp_constant(tok));

		if (c) {

			fputs_v("ZEC", f);

		} else {

			CV_SPEC cv = DEREF_cv(type_qual(t));

			if (cv & cv_lvalue) {

				fputs_v("ZEL", f);

			} else {

				fputs_v("ZER", f);

			}

		}

		dump_type(t);

		break;

	}

	case tok_stmt_tag: {

		/* Statement tokens */

		fputs_v("ZS", f);

		break;

	}

	case tok_nat_tag: {

		/* Integer constant tokens */

		fputs_v("ZN", f);

		break;

	}

	case tok_snat_tag: {

		/* Integer constant tokens */

		fputs_v("ZI", f);

		break;

	}

	case tok_type_tag: {

		/* Type tokens */

		int c;

		BASE_TYPE bt = DEREF_btype(tok_type_kind(tok));