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 "ftype_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 "off_ops.h"

#include "tok_ops.h"

#include "type_ops.h"

#include "error.h"

#include "catalog.h"

#include "basetype.h"

#include "bits.h"

#include "buffer.h"

#include "char.h"

#include "chktype.h"

#include "class.h"

#include "constant.h"

#include "convert.h"

#include "decode.h"

#include "derive.h"

#include "dump.h"

#include "encode.h"

#include "exception.h"

#include "file.h"

#include "function.h"

#include "hash.h"

#include "inttype.h"

#include "lex.h"

#include "literal.h"

#include "load.h"

#include "merge.h"

#include "namespace.h"

#include "redeclare.h"

#include "save.h"

#include "symbols.h"

#include "syntax.h"

#include "token.h"

#include "ustring.h"

#include "xalloc.h"

/*

    FORWARD DECLARATIONS

    The following forward declarations are required in the spec input

    routines.

*/

static EXP load_exp(BITSTREAM *, TYPE);

static TYPE load_type(BITSTREAM *, IDENTIFIER);

static TYPE load_ctype(BITSTREAM *, IDENTIFIER, CLASS_TYPE *);

static IDENTIFIER load_id(BITSTREAM *, NAMESPACE);

static LIST(TYPE)load_type_list(BITSTREAM *);

static TOKEN load_tok(BITSTREAM *, int);

static void load_nspace(BITSTREAM *, NAMESPACE, int);

/*

    SPEC INPUT ERROR FLAG

    This flag is set to true to indicate a spec input error.

*/

static int spec_error = 0;

/*

    SPEC ERROR ROUTINE

    This routine is called when a spec input error occurs.  code gives

    the reason for the error.

*/

static void

spec_fail(int code)

{

	if (!spec_error) {

		spec_error = code;

	}

	return;

}

/*

    SPEC ERROR CODES

    The spec error codes are given by the corresponding source line.

    This macro gives a convenient shorthand for calling spec_fail.

*/

#ifdef __LINE__

#define SPEC_ERROR()		spec_fail(__LINE__)

#else

#define SPEC_ERROR()		spec_fail(100)

#endif

/*

    SIMPLE READING ROUTINES

    These macros give the simple reading routines for the enumeration

    types etc.  Note that DE_BITS_2 is used for types which occupy more

    than 16 bits.

*/

#define load_btype(A)		(BASE_TYPE)DE_BITS_2((A), BITS_btype)

#define load_cinfo(A)		(CLASS_INFO)DE_BITS_2((A), BITS_cinfo)

#define load_cusage(A)	(CLASS_USAGE)DE_BITS((A), BITS_cusage)

#define load_cv(A)		(CV_SPEC)DE_BITS((A), BITS_cv_qual)

#define load_dspec(A)		(DECL_SPEC)DE_BITS_2((A), BITS_dspec)

#define load_mqual(A)		(CV_SPEC)DE_BITS((A), BITS_cv)

#define load_qual(A)		(QUALIFIER)DE_BITS((A), BITS_qual)

/*

    READ A LEXICAL TOKEN NUMBER

    This routine reads a lexical token number from the bitstream bs.

*/

static int

load_lex(BITSTREAM *bs)

{

	int t = (int)DE_BITS(bs, BITS_lex);

	if (t > LAST_TOKEN) {

		t = lex_unknown;

		SPEC_ERROR();

	}

	return (t);

}

/*

    READ A LIST OF PREPROCESSING TOKENS

    This routine reads a list of preprocessing tokens from the

    bitstream bs.

*/

static PPTOKEN *

load_pptoks(BITSTREAM *bs)

{

	/* NOT YET IMPLEMENTED */

	UNUSED(bs);

	return (NULL);

}

/*

    READ A LOCATION

    This routine reads the current location from the bitstream bs.

*/

static void

load_loc(BITSTREAM *bs)

{

	if (DE_BOOL(bs)) {

		/* Line number has changed */

		crt_loc.line = DE_INT(bs);

		crt_loc.column = 0;

		if (DE_BOOL(bs)) {

			/* File position has changed */

			string file;

			string input;

			ulong date, date2;

			STAT_TYPE *fs = NULL;

			PTR(POSITION)posn;

			PTR(LOCATION)from = NULL_ptr(LOCATION);

			unsigned long off = DE_INT(bs);

			if (DE_BOOL(bs)) {

				STAT_TYPE fstr;

				BUFFER *bf = clear_buffer(&token_buff,

							  NIL(FILE));

				de_tdfstring(bs, bf);

				file = xustrcpy(bf->start);

				if (DE_BOOL(bs)) {

					bf = clear_buffer(&token_buff,

							  NIL(FILE));

					de_tdfstring(bs, bf);

					input = xustrcpy(bf->start);

				} else {

					input = file;

				}

				date = DE_INT(bs);

				fs = stat_func(strlit(input), &fstr);

				date2 = stat_date(fs);

			} else {

				posn = crt_loc.posn;

				file = DEREF_string(posn_file(posn));

				input = DEREF_string(posn_input(posn));

				date = DEREF_ulong(posn_datestamp(posn));

				date2 = date;

			}

			posn = MAKE_ptr(SIZE_posn);

			MAKE_posn(file, input, input, NULL, off, from, date,

				  posn);

			crt_loc.posn = posn;

			if (date && date2 && date != date2) {

				/* File has changed on disk */

				if (!already_included(input, fs, 4)) {

					report(crt_loc, ERR_cpp_include_date());

				}

			}

		}

	}

	return;

}

/*

    READ AN IDENTIFIER NAME

    This routine reads an identifier name from the bitstream bs.  ns gives

    the current namespace.

*/

static HASHID

load_hashid(BITSTREAM *bs, NAMESPACE ns)

{

	HASHID nm = NULL_hashid;

	unsigned n = DE_BITS(bs, BITS_hashid);

	if (n) {

		if (n <= ORDER_hashid) {

			unsigned tag = n - 1;

			ASSERT(ORDER_hashid == 7);

			switch (tag) {

			case hashid_name_tag:

			case hashid_ename_tag: {

				string s;

				int ext = 0;

				unsigned long h;

				BUFFER *bf = clear_buffer(&token_buff,

							  NIL(FILE));

				de_tdfstring(bs, bf);

				s = bf->start;

				h = hash(s);

				if (tag == hashid_ename_tag) {

					ext = 1;

				}

				nm = lookup_name(s, h, ext, lex_unknown);

				break;

			}

			case hashid_constr_tag: {

				if (IS_nspace_ctype(ns)) {

					IDENTIFIER cid =

					    DEREF_id(nspace_name(ns));

					if (IS_id_class_name(cid)) {

						TYPE t;

						t = DEREF_type(id_class_name_defn(cid));

						nm = lookup_constr(t, cid);

						break;

					}

				}

				SPEC_ERROR();

				break;

			}

			case hashid_destr_tag: {

				if (IS_nspace_ctype(ns)) {

					IDENTIFIER cid =

					    DEREF_id(nspace_name(ns));

					if (IS_id_class_name(cid)) {

						TYPE t;

						t = DEREF_type(id_class_name_defn(cid));

						nm = lookup_destr(t, cid);

						break;

					}

				}

				SPEC_ERROR();

				break;

			}

			case hashid_conv_tag: {

				TYPE t = load_type(bs, NULL_id);

				if (!IS_NULL_type(t)) {

					nm = lookup_conv(t);

					break;

				}

				SPEC_ERROR();

				break;

			}

			case hashid_op_tag: {

				int op = load_lex(bs);

				nm = lookup_op(op);

				break;

			}

			case hashid_anon_tag: {

				nm = lookup_anon();

				break;

			}

			}

		} else {

			SPEC_ERROR();

		}

	}

	return (nm);

}

/*

    READ A LIST OF IDENTIFIER NAMES

    This routine reads a list of identifier names from the bitstream bs.

*/

static LIST(HASHID)

load_hashid_list(BITSTREAM *bs, NAMESPACE ns)

{

	LIST(HASHID)p = NULL_list(HASHID);

	while (DE_BOOL(bs)) {

		HASHID nm = load_hashid(bs, ns);

		if (IS_NULL_hashid(nm)) {

			SPEC_ERROR();

			break;

		}

		CONS_hashid(nm, p, p);

	}

	p = REVERSE_list(p);

	return (p);

}

/*

    IDENTIFIER LOOK-UP TABLE

    These variables give the table which gives the mapping between identifier

    numbers and identifiers.

*/

static IDENTIFIER *id_table = NULL;

static ulong id_table_size = 0;

static ulong ids_pending = 0;

/*

    LOOK UP IDENTIFIER IN TABLE

    This routine returns a pointer to the dth element of the table above,

    extending it if necessary.

*/

static IDENTIFIER *

id_lookup(ulong d)

{

	ulong m = id_table_size;

	IDENTIFIER *p = id_table;

	if (d >= m) {

		ulong n = d + 100;

		p = xrealloc_nof(p, IDENTIFIER, n);

		while (m < n) {

			p[m] = NULL_id;

			m++;

		}

		id_table_size = n;

		id_table = p;

	}

	return (p + d);

}

/*

    READ AN IDENTIFIER NUMBER

    This routine reads an identifier number from the bitstream bs.  It is

    possible for an identifier to be used before it is declared using

    load_id.

*/

static IDENTIFIER

load_use(BITSTREAM *bs, unsigned tag)

{

	IDENTIFIER id;

	IDENTIFIER *pid;

	ulong d = DE_INT(bs);

	if (d == 0) {

		/* Null identifier */

		return (NULL_id);

	}

	pid = id_lookup(d);

	id = *pid;

	if (IS_NULL_id(id)) {

		/* Create dummy identifier */

		HASHID nm = KEYWORD(lex_zzzz);

		MAKE_id_pending(nm, dspec_none, NULL_nspace, crt_loc,

				tag, NULL_type, id);

		COPY_ulong(id_dump(id), d);

		ids_pending++;

		*pid = id;

	}

	return (id);

}

/*

    READ A LIST OF IDENTIFIER NUMBERS

    This routine reads a list of identifier numbers from the bitstream bs.

*/

static LIST(IDENTIFIER)

load_use_list(BITSTREAM *bs)

{

	LIST(IDENTIFIER)p = NULL_list(IDENTIFIER);

	while (DE_BOOL(bs)) {

		IDENTIFIER id = load_use(bs, null_tag);

		if (spec_error) {

			break;

		}

		CONS_id(id, p, p);

	}

	p = REVERSE_list(p);

	return (p);

}

/*

    READ A LIST OF TOKENS

    This routine reads a list of tokens from the bitstream bs.  def is

    as in load_tok.

*/

static LIST(TOKEN)

load_tok_list(BITSTREAM *bs, int def)

{

	LIST(TOKEN)p = NULL_list(TOKEN);

	while (DE_BOOL(bs)) {

		TOKEN tok = load_tok(bs, def);

		if (spec_error) {

			break;

		}

		CONS_tok(tok, p, p);

	}

	p = REVERSE_list(p);

	return (p);

}

/*

    READ AN INTEGER CONSTANT

    This routine reads an integer constant from the bitstream bs.

*/

static NAT

load_nat(BITSTREAM *bs)

{

	NAT m = NULL_nat;

	unsigned n = DE_BITS(bs, BITS_nat);

	if (n == 0) {

		/* Null constants */

		return (m);

	}

	if (n > ORDER_nat) {

		SPEC_ERROR();

		return (m);

	}

	ASSERT(ORDER_nat == 5);

	switch (n - 1) {

	case nat_small_tag: {

		unsigned long v = DE_INT(bs);

		m = make_nat_value(v);

		break;

	}

	case nat_large_tag: {

		int count = 0;

		LIST(unsigned)p = NULL_list(unsigned);

		while (DE_BOOL(bs)) {

			unsigned v = (unsigned)DE_INT(bs);

			CONS_unsigned(v, p, p);

			if (++count == 10) {

				/* Check for end of file */

				if (de_eof(bs)) {

					SPEC_ERROR();

					break;

				}

				count = 0;

			}

		}

		p = REVERSE_list(p);

		m = make_large_nat(p);

		break;

	}

	case nat_calc_tag: {

		EXP e = load_exp(bs, type_sint);

		if (!IS_NULL_exp(e)) {

			MAKE_nat_calc(e, m);

			break;

		}

		SPEC_ERROR();

		break;

	}

	case nat_neg_tag: {

		m = load_nat(bs);

		if (!IS_NULL_nat(m)) {

			m = negate_nat(m);

			break;

		}

		SPEC_ERROR();

		break;

	}

	case nat_token_tag: {

		IDENTIFIER tok = load_use(bs, null_tag);

		if (!IS_NULL_id(tok)) {

			LIST(TOKEN)args = load_tok_list(bs, 1);

			MAKE_nat_token(tok, args, m);

			break;

		}

		SPEC_ERROR();

		break;

	}

	}

	return (m);

}

/*

    READ AN OFFSET

    This routine reads an offset from the bitstream bs.

*/

static OFFSET

load_off(BITSTREAM *bs)

{

	/* NOT YET IMPLEMENTED */

	UNUSED(bs);

	return (NULL_off);

}

/*

    READ AN EXPRESSION

    This routine reads an expression from the bitstream bs.

*/

static EXP

load_exp(BITSTREAM *bs, TYPE t)

{

	unsigned tag;

	EXP e = NULL_exp;

	unsigned n = DE_BITS(bs, BITS_exp);

	if (n == 0) {

		/* Null expressions */

		return (e);

	}

	if (n > ORDER_exp) {

		SPEC_ERROR();

		return (e);

	}

	tag = n - 1;

	switch (tag) {

	case exp_int_lit_tag: {

		NAT m = load_nat(bs);

		if (!IS_NULL_nat(m)) {

			unsigned etag = DE_BITS(bs, BITS_exp);

			if (etag < ORDER_exp) {

				MAKE_exp_int_lit(t, m, etag, e);

				break;

			}

		}

		SPEC_ERROR();

		break;

	}

	case exp_token_tag: {

		IDENTIFIER tok = load_use(bs, null_tag);

		if (!IS_NULL_id(tok)) {

			LIST(TOKEN)args = load_tok_list(bs, 1);

			MAKE_exp_token(t, tok, args, e);

			break;

		}

		SPEC_ERROR();

		break;

	}

	default: {

		/* NOT YET IMPLEMENTED */

		MAKE_exp_value(t, e);

		break;

	}

	}

	return (e);

}

/*

    READ A BUILT-IN TYPE

    This routine reads a built-in type number from the bitstream bs.

*/

static BUILTIN_TYPE

load_ntype(BITSTREAM *bs)

{

	BUILTIN_TYPE nt = (BUILTIN_TYPE)DE_BITS(bs, BITS_ntype);

	if (nt >= ORDER_ntype) {

		nt = ntype_none;

		SPEC_ERROR();

	}

	return (nt);

}

/*

    READ AN INTEGRAL TYPE

    This routine reads a integral type from the bitstream bs.  Note that

    the result is returned as a type rather than an integral type.

*/

static TYPE

load_itype(BITSTREAM *bs, CV_SPEC cv, unsigned tag)

{

	TYPE t = NULL_type;

	unsigned n = DE_BITS(bs, BITS_itype);

	if (n == 0) {

		/* Null types */

		return (t);

	}

	if (n > ORDER_itype) {

		SPEC_ERROR();

		return (t);

	}

	switch (n - 1) {

	case itype_basic_tag: {

		BUILTIN_TYPE nt = load_ntype(bs);

		t = type_builtin[nt];

		break;

	}

	case itype_bitfield_tag: {

		TYPE s = load_type(bs, NULL_id);

		if (!IS_NULL_type(s)) {

			BASE_TYPE bt = load_btype(bs);

			NAT m = load_nat(bs);

			if (!IS_NULL_nat(m)) {

				t = check_bitfield_type(cv, s, bt, m, 1);

				cv = cv_none;

				break;

			}

		}

		SPEC_ERROR();

		break;

	}

	case itype_promote_tag: {

		TYPE s = load_itype(bs, cv_none, type_integer_tag);

		if (!IS_NULL_type(s)) {

			t = promote_type(s);

			break;

		}

		SPEC_ERROR();

		break;

	}

	case itype_arith_tag: {

		TYPE s = load_itype(bs, cv_none, type_integer_tag);

		if (!IS_NULL_type(s)) {

			TYPE r = load_itype(bs, cv_none, type_integer_tag);

			if (!IS_NULL_type(r)) {

				t = arith_itype(s, r, NULL_exp, NULL_exp);

				break;

			}

		}

		SPEC_ERROR();

		break;

	}

	case itype_literal_tag: {

		NAT m = load_nat(bs);

		if (!IS_NULL_nat(m)) {

			int form = (int)DE_BITS(bs, 2);

			if (form >= 0 && form < BASE_NO) {

				int suff = (int)DE_BITS(bs, 3);

				if (suff >= 0 && suff < SUFFIX_NO) {

					int fit = 0;

					string str = NULL_string;

					t = find_literal_type(m, form, suff,

							      str, &fit);

					break;

				}

			}

		}

		SPEC_ERROR();

		break;

	}

	case itype_token_tag: {

		IDENTIFIER tok = load_use(bs, null_tag);

		if (!IS_NULL_id(tok)) {

			LIST(TOKEN)args = load_tok_list(bs, 1);

			t = apply_itype_token(tok, args);

			break;

		}

		SPEC_ERROR();

		break;

	}

	}

	if (!IS_NULL_type(t)) {

		if (TAG_type(t) == tag) {

			if (cv) {

				t = qualify_type(t, cv, 0);

			}

		} else {

			SPEC_ERROR();

		}

	}

	return (t);

}

/*

    READ A FLOATING POINT TYPE

    This routine reads a floating point type from the bitstream bs.  Note

    that the result is returned as a type rather than a floating point type.

*/

static TYPE

load_ftype(BITSTREAM *bs, CV_SPEC cv)

{

	TYPE t = NULL_type;

	unsigned n = DE_BITS(bs, BITS_ftype);

	if (n == 0) {

		/* Null types */

		return (t);

	}

	if (n > ORDER_ftype) {

		SPEC_ERROR();

		return (t);

	}

	ASSERT(ORDER_ftype == 4);

	switch (n - 1) {

	case ftype_basic_tag: {

		BUILTIN_TYPE nt = load_ntype(bs);

		t = type_builtin[nt];

		break;

	}

	case ftype_arg_promote_tag: {

		TYPE s = load_ftype(bs, cv_none);

		if (!IS_NULL_type(s)) {

			t = arg_promote_type(s, KILL_err);

			break;

		}

		SPEC_ERROR();

		break;

	}

	case ftype_arith_tag: {

		TYPE s = load_ftype(bs, cv_none);

		if (!IS_NULL_type(s)) {

			TYPE r = load_ftype(bs, cv_none);

			if (!IS_NULL_type(r)) {

				t = arith_ftype(s, r);

				break;

			}

		}

		SPEC_ERROR();

		break;

	}

	case ftype_token_tag: {

		IDENTIFIER tok = load_use(bs, null_tag);

		if (!IS_NULL_id(tok)) {

			LIST(TOKEN)args = load_tok_list(bs, 1);

			t = apply_ftype_token(tok, args);

			break;

		}

		break;

	}

	}

	if (!IS_NULL_type(t)) {

		if (IS_type_floating(t)) {

			if (cv)t = qualify_type(t, cv, 0);

		} else {

			SPEC_ERROR();

			t = NULL_type;