/*
* 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/construct/token.c,v 1.8 2004/08/15 11:13:36 bp Exp $
*/
#include "config.h"
#include "producer.h"
#include <limits.h>
#include "msgcat.h"
#include "c_types.h"
#include "ctype_ops.h"
#include "etype_ops.h"
#include "exp_ops.h"
#include "ftype_ops.h"
#include "hashid_ops.h"
#include "id_ops.h"
#include "itype_ops.h"
#include "nat_ops.h"
#include "nspace_ops.h"
#include "member_ops.h"
#include "off_ops.h"
#include "tok_ops.h"
#include "type_ops.h"
#include "error.h"
#include "catalog.h"
#include "option.h"
#include "access.h"
#include "basetype.h"
#include "check.h"
#include "chktype.h"
#include "class.h"
#include "constant.h"
#include "convert.h"
#include "copy.h"
#include "declare.h"
#include "dump.h"
#include "exception.h"
#include "expression.h"
#include "function.h"
#include "hash.h"
#include "identifier.h"
#include "initialise.h"
#include "instance.h"
#include "inttype.h"
#include "lex.h"
#include "macro.h"
#include "namespace.h"
#include "parse.h"
#include "predict.h"
#include "preproc.h"
#include "redeclare.h"
#include "statement.h"
#include "syntax.h"
#include "template.h"
#include "tok.h"
#include "tokdef.h"
#include "token.h"
/*
* FIND A TYPE TOKEN KEY
*
* This routine returns the keyword associated with a type token of
* kind bt.
*/
int
type_token_key(BASE_TYPE bt)
{
int key = lex_type_Hcap;
if (bt & btype_float) {
if (bt & btype_star) {
key = lex_scalar_Hcap;
} else if (bt & btype_int) {
key = lex_arith_Hcap;
} else {
key = lex_float_Hcap;
}
} else if (bt & btype_int) {
if (bt & btype_signed) {
key = lex_signed;
} else if (bt & btype_unsigned) {
key = lex_unsigned;
} else {
key = lex_variety_Hcap;
}
} else if (bt == btype_class) {
key = lex_class_Hcap;
} else if (bt == btype_struct) {
key = lex_struct_Hcap;
} else if (bt == btype_union) {
key = lex_union_Hcap;
}
return (key);
}
/*
* CREATE A TYPE TOKEN
*
* This routine creates a type token of kind bt.
*/
TOKEN
make_type_token(BASE_TYPE bt)
{
TOKEN tok;
MAKE_tok_type (bt, NULL_type, tok);
return (tok);
}
/*
* CREATE AN EXPRESSION TOKEN
*
* This routine creates an expression token of type t.
*/
TOKEN
make_exp_token(TYPE t, int lv, int c)
{
TOKEN tok;
if (lv) {
t = lvalue_type (t);
} else {
t = rvalue_type (t);
}
object_type (t, id_token_tag);
MAKE_tok_exp (t, c, NULL_exp, tok);
return (tok);
}
/*
* CREATE A FUNCTION TOKEN
*
* This routine creates a function token of type t.
*/
TOKEN
make_func_token(TYPE t)
{
int ell;
TOKEN tok;
if (!IS_type_func (t)) {
report (preproc_loc, ERR_token_func (t));
tok = make_exp_token (t, 0, 0);
return (tok);
}
ell = DEREF_int (type_func_ellipsis (t));
if (ell & FUNC_NO_PARAMS) {
/* Map 't ()' to 't (void)' */
COPY_int (type_func_ellipsis (t), FUNC_NONE);
}
MAKE_tok_func (t, tok);
return (tok);
}
/*
* CREATE A MEMBER SELECTOR TOKEN
*
* This routine creates a member selector token for a member of s of
* type t. acc gives the member access.
*/
TOKEN
make_member_token(TYPE t, TYPE s, DECL_SPEC acc)
{
TOKEN tok;
if (!IS_type_compound (s)) {
report (preproc_loc, ERR_token_mem (s));
tok = make_exp_token (t, 0, 0);
return (tok);
}
#if LANGUAGE_CPP
crt_access = acc;
#else
UNUSED (acc);
#endif
MAKE_tok_member (s, t, NULL_off, tok);
return (tok);
}
/*
* CHECK A TOKEN PARAMETER OR RESULT SORT
*
* Procedure tokens which take or return other procedure tokens are not
* allowed. This routine checks the parameter token sort tok.
*/
static TOKEN
check_param_sort(TOKEN tok)
{
if (!IS_NULL_tok (tok)) {
if (IS_tok_func (tok)) {
tok = func_proc_token (tok);
}
if (IS_tok_proc (tok)) {
report (preproc_loc, ERR_token_proc_high ());
tok = DEREF_tok (tok_proc_res (tok));
}
}
return (tok);
}
/*
* BEGIN THE DEFINITION OF A PROCEDURE TOKEN
*
* This routine begins the construction of a procedure token.
*/
TOKEN
begin_proc_token()
{
TOKEN tok;
begin_param (NULL_id);
MAKE_tok_proc (NULL_tok, crt_namespace, lex_identifier, tok);
return (tok);
}
/*
* SET THE PARAMETER NUMBERS FOR A PROCEDURE TOKEN
*
* This routine sets the token numbers for the list of procedure token
* parameters p.
*/
void
set_proc_token(LIST (IDENTIFIER) p)
{
ulong n = 0;
while (!IS_NULL_list (p)) {
IDENTIFIER pid = DEREF_id (HEAD_list (p));
if (!IS_NULL_id (pid)) {
COPY_ulong (id_no (pid), n);
}
n++;
p = TAIL_list (p);
}
return;
}
/*
* CONTINUE THE DEFINITION OF A PROCEDURE TOKEN
*
* This routine continues the definition of the procedure token prev
* by adding the lists of bound and program parameters, p and q.
*/
TOKEN
cont_proc_token(TOKEN prev, LIST (IDENTIFIER) p, LIST (IDENTIFIER) q)
{
if (!IS_NULL_tok (prev)) {
unsigned n;
if (!EQ_list (p, q)) {
int eq = 1;
LIST (IDENTIFIER) ps = p;
LIST (IDENTIFIER) qs = q;
while (!IS_NULL_list (ps) && !IS_NULL_list (qs)) {
IDENTIFIER ip = DEREF_id (HEAD_list (ps));
IDENTIFIER iq = DEREF_id (HEAD_list (qs));
if (!EQ_id (ip, iq)) {
eq = 0;
break;
}
ps = TAIL_list (ps);
qs = TAIL_list (qs);
}
if (eq && EQ_list (ps, qs)) {
/* Parameter lists match */
DESTROY_list (q, SIZE_id);
q = p;
} else {
set_proc_token (q);
}
}
set_proc_token (p);
COPY_list (tok_proc_bids (prev), p);
COPY_list (tok_proc_pids (prev), q);
n = LENGTH_list (q);
IGNORE check_value (OPT_VAL_macro_pars, (ulong) n);
}
return (prev);
}
/*
* COMPLETE THE DEFINITION OF A PROCEDURE TOKEN
*
* This routine completes the definition of the procedure token prev by
* filling in the token result sort res.
*/
TOKEN
end_proc_token(TOKEN prev, TOKEN res)
{
res = check_param_sort (res);
if (!IS_NULL_tok (prev)) {
COPY_tok (tok_proc_res (prev), res);
}
end_param ();
return (prev);
}
/*
* CREATE A TOKEN PARAMETER
*
* This routine declares a token bound parameter of sort tok with name
* id, which belongs to the tag namespace if tag is true.
*/
IDENTIFIER
make_tok_param(TOKEN tok, int tag, IDENTIFIER id)
{
if (IS_NULL_id (id)) {
HASHID nm = lookup_anon ();
id = DEREF_id (hashid_id (nm));
}
tok = check_param_sort (tok);
id = make_token_decl (tok, tag, id, NULL_id);
if (do_dump) dump_token_param (id);
return (id);
}
/*
* FIND A TOKEN MEMBER
*
* This routine looks up a member id of the class type t. If the member
* is not found or t is not a class type then an error message is printed
* and the null identifier is returned.
*/
IDENTIFIER
tok_member(IDENTIFIER id, TYPE t, int force)
{
if (IS_type_compound (t)) {
HASHID nm = DEREF_hashid (id_name (id));
CLASS_TYPE ct = DEREF_ctype (type_compound_defn (t));
NAMESPACE ns = DEREF_nspace (ctype_member (ct));
IDENTIFIER fid = search_id (ns, nm, 0, 0);
if (IS_NULL_id (fid)) {
/* Member not declared */
if (force) {
/* Report error */
report (preproc_loc, ERR_lookup_qual_bad (id, ns));
} else {
/* Create token member */
TOKEN tok;
HASHID fnm = lookup_anon ();
fid = DEREF_id (hashid_id (fnm));
MAKE_tok_member (t, type_error, NULL_off, tok);
fid = make_token_decl (tok, 0, id, fid);
fid = DEREF_id (id_token_alt (fid));
}
}
return (fid);
}
report (preproc_loc, ERR_token_mem (t));
return (NULL_id);
}
/*
* CREATE A TOKEN PROGRAM PARAMETER
*
* This routine declares a token program parameter named id. tt gives
* the associated token sort, while t gives the structure type if this
* denotes a member token or the parameter type if this denotes a type
* token.
*/
IDENTIFIER
prog_tok_param(IDENTIFIER id, TYPE t, unsigned tt, LIST (IDENTIFIER) p)
{
/* Look up member identifier */
IDENTIFIER tid = id;
if (tt == tok_member_tag) {
tid = tok_member (tid, t, 1);
if (IS_NULL_id (tid)) return (NULL_id);
}
/* Check through tokens */
while (!IS_NULL_list (p)) {
IDENTIFIER pid = DEREF_id (HEAD_list (p));
if (!IS_NULL_id (pid) && IS_id_token (pid)) {
IDENTIFIER qid = DEREF_id (id_token_alt (pid));
if (EQ_id (qid, tid)) {
/* Matching token found */
TOKEN tok = DEREF_tok (id_token_sort (pid));
unsigned pt = TAG_tok (tok);
switch (pt) {
case tok_nat_tag :
case tok_snat_tag : {
pt = tok_exp_tag;
break;
}
case tok_templ_tag :
case tok_func_tag : {
pt = tok_proc_tag;
break;
}
}
if (pt != tt) {
/* Wrong sort given for token parameter */
report (preproc_loc, ERR_token_arg_sort (pid));
}
return (pid);
}
}
p = TAIL_list (p);
}
/* Allow for complex type parameters */
if (tt == tok_type_tag) {
HASHID nm = lookup_anon ();
int tq = crt_templ_qualifier;
QUALIFIER cq = crt_id_qualifier;
crt_id_qualifier = qual_none;
crt_templ_qualifier = 0;
tid = DEREF_id (hashid_id (nm));
tid = make_object_decl (dspec_typedef, t, tid, 0);
crt_templ_qualifier = tq;
crt_id_qualifier = cq;
return (tid);
}
report (preproc_loc, ERR_token_arg_bad (tid));
return (NULL_id);
}
/*
* FIND AN UNDERLYING PROCEDURE TOKEN
*
* This routine returns the procedure token underlying the function
* token tok, creating this if necessary.
*/
TOKEN
func_proc_token(TOKEN tok)
{
TOKEN res;
if (!IS_tok_func (tok)) return (tok);
res = DEREF_tok (tok_func_proc (tok));
if (IS_NULL_tok (res)) {
TYPE t = DEREF_type (tok_func_type (tok));
int ell = DEREF_int (type_func_ellipsis (t));
if (ell & FUNC_ELLIPSIS) {
res = tok;
} else {
TOKEN rtok;
IDENTIFIER pid;
EXP e = NULL_exp;
LIST (IDENTIFIER) qids;
IDENTIFIER fn = DEREF_id (tok_func_defn (tok));
TYPE r = DEREF_type (type_func_ret (t));
LIST (TYPE) p = DEREF_list (type_func_mtypes (t));
LIST (IDENTIFIER) pids = NULL_list (IDENTIFIER);
res = begin_proc_token ();
while (!IS_NULL_list (p)) {
/* Normal function parameters */
TYPE s = DEREF_type (HEAD_list (p));
if (pass_complex_type (s)) {
MAKE_type_ptr (cv_none, s, s);
}
MAKE_tok_exp (s, 0, NULL_exp, rtok);
pid = make_tok_param (rtok, 0, NULL_id);
CONS_id (pid, pids, pids);
p = TAIL_list (p);
}
/* Extra constructor parameters ... */
pids = REVERSE_list (pids);
qids = pids;
if (pass_complex_type (r)) {
/* Complex function return */
TYPE s;
MAKE_type_ptr (cv_none, r, s);
MAKE_tok_exp (s, 0, NULL_exp, rtok);
pid = make_tok_param (rtok, 0, NULL_id);
CONS_id (pid, pids, pids);
r = type_void;
}
res = cont_proc_token (res, pids, qids);
if (!IS_NULL_id (fn)) {
/* Token already defined */
MAKE_exp_value (t, e);
}
MAKE_tok_exp (r, 0, e, rtok);
res = end_proc_token (res, rtok);
}
COPY_tok (tok_func_proc (tok), res);
}
return (res);
}
/*
* EXPAND A TOKEN VALUE
*
* This routine expands the token value tok. If force is true then a copy
* is always made.
*/
TOKEN
expand_sort(TOKEN tok, int rec, int force)
{
if (!IS_NULL_tok (tok)) {
unsigned tag = TAG_tok (tok);
switch (tag) {
case tok_exp_tag : {
/* Expression tokens */
EXP a1 = DEREF_exp (tok_exp_value (tok));
EXP a2 = expand_exp (a1, rec, 0);
if (force || !eq_exp_exact (a1, a2)) {
int c = DEREF_int (tok_exp_constant (tok));
TYPE t = DEREF_type (tok_exp_type (tok));
t = expand_type (t, rec);
MAKE_tok_exp (t, c, a2, tok);
}
break;
}
case tok_nat_tag :
case tok_snat_tag : {
/* Integral constant tokens */
ERROR err = NULL_err;
NAT n1 = DEREF_nat (tok_nat_etc_value (tok));
NAT n2 = expand_nat (n1, rec, 0, &err);
if (!IS_NULL_err (err)) report (crt_loc, err);
if (force || !EQ_nat (n1, n2)) {
MAKE_tok_nat_etc (tag, n2, tok);
}
break;
}
case tok_stmt_tag : {
/* Statement tokens */
EXP a1 = DEREF_exp (tok_stmt_value (tok));
EXP a2 = expand_exp (a1, rec, 1);
if (force || !eq_exp_exact (a1, a2)) {
EXP b = get_parent_stmt (a1);
set_parent_stmt (a2, b);
MAKE_tok_stmt (a2, tok);
}
break;
}
case tok_member_tag : {
/* Member tokens */
OFFSET a1 = DEREF_off (tok_member_value (tok));
OFFSET a2 = expand_offset (a1, rec);
if (force || !EQ_off (a1, a2)) {
TYPE s = DEREF_type (tok_member_of (tok));
TYPE t = DEREF_type (tok_member_type (tok));
s = expand_type (s, rec);
t = expand_type (t, rec);
MAKE_tok_member (s, t, a2, tok);
}
break;
}
case tok_type_tag : {
/* Type tokens */
TYPE t1 = DEREF_type (tok_type_value (tok));
TYPE t2 = expand_type (t1, rec);
if (force || !EQ_type (t1, t2)) {
BASE_TYPE bs = DEREF_btype (tok_type_kind (tok));
MAKE_tok_type (bs, t2, tok);
}
break;
}
case tok_class_tag : {
/* Template class tokens */
IDENTIFIER cid = DEREF_id (tok_class_value (tok));
/* NOT YET IMPLEMENTED */
if (force) {
TYPE s = DEREF_type (tok_class_type (tok));
TYPE t = DEREF_type (tok_class_alt (tok));
MAKE_tok_class (s, cid, tok);
COPY_type (tok_class_alt (tok), t);
}
break;
}
case tok_templ_tag : {
/* Template tokens */
if (force) {
int d;
LIST (IDENTIFIER) pids;
LIST (IDENTIFIER) rids;
LIST (IDENTIFIER) qids = NULL_list (IDENTIFIER);
DECL_SPEC ds = DEREF_dspec (tok_templ_usage (tok));
NAMESPACE ns = DEREF_nspace (tok_templ_pars (tok));
pids = DEREF_list (tok_templ_pids (tok));
rids = pids;
d = save_token_args (rids, NULL_list (TOKEN));
while (!IS_NULL_list (pids)) {
/* Copy template parameters */
TOKEN arg;
IDENTIFIER qid2;
IDENTIFIER pid = DEREF_id (HEAD_list (pids));
IDENTIFIER pid2 = DEREF_id (id_token_alt (pid));
IDENTIFIER qid = copy_id (pid, 2);
DECL_SPEC qds = DEREF_dspec (id_storage (qid));
qds |= dspec_pure;
COPY_dspec (id_storage (qid), qds);
arg = apply_token (qid, NULL_list (TOKEN));
assign_token (pid, arg);
qid2 = copy_id (pid2, 2);
COPY_id (id_token_alt (qid), qid2);
CONS_id (qid, qids, qids);
pids = TAIL_list (pids);
}
restore_token_args (rids, d);
MAKE_tok_templ (ds, ns, tok);
qids = REVERSE_list (qids);
COPY_list (tok_templ_pids (tok), qids);
set_proc_token (qids);
}
break;
}
}
}
return (tok);
}
/*
* EXPAND A LIST OF TOKEN ARGUMENTS
*
* This routine expands the list of token arguments p passing the parameter
* rec to the individual expansion routines. The null list is returned to
* indicate that the expansion has no effect.
*/
LIST (TOKEN)
expand_args(LIST (TOKEN) p, int rec, int force)
{
int changed = 0;
LIST (TOKEN) q = NULL_list (TOKEN);
while (!IS_NULL_list (p)) {
TOKEN a = DEREF_tok (HEAD_list (p));
TOKEN b = expand_sort (a, rec, force);
if (!EQ_tok (a, b)) changed = 1;
CONS_tok (b, q, q);
p = TAIL_list (p);
}
if (!changed) {
/* No effect */
DESTROY_list (q, SIZE_tok);
return (NULL_list (TOKEN));
}
q = REVERSE_list (q);
return (q);
}
/*
* EXPAND A TEMPLATE SORT
*
* This routine copies the given template sort producing a new sort
* comprising only those parameters which are unbound. If all the
* parameters are bound then the null sort is returned.
*/
TOKEN
expand_templ_sort(TOKEN sort, int rec)
{
NAMESPACE ns;
int changed = 0;
int all_unbound = 1;
LIST (TOKEN) dargs = NULL_list (TOKEN);
DECL_SPEC ex = DEREF_dspec (tok_templ_usage (sort));
LIST (IDENTIFIER) p = DEREF_list (tok_templ_pids (sort));
LIST (IDENTIFIER) q = NULL_list (IDENTIFIER);
LIST (IDENTIFIER) p0 = p;
while (!IS_NULL_list (p)) {
IDENTIFIER pid = DEREF_id (HEAD_list (p));
if (!IS_NULL_id (pid) && IS_id_token (pid)) {
TOKEN tok = DEREF_tok (id_token_sort (pid));
if (is_bound_tok (tok, 0)) {
/* Have bound parameter */
all_unbound = 0;
changed = 1;
} else {
/* Add unbound parameter to list */
/* NOT YET IMPLEMENTED */
CONS_id (pid, q, q);
}
}
p = TAIL_list (p);
}
if (IS_NULL_list (q)) {
/* All parameters are bound */
return (NULL_tok);
}
if (changed) {
/* Get unbound parameters into order */
q = REVERSE_list (q);
} else {
/* Use existing list */
DESTROY_list (q, SIZE_id);
q = p0;
}
if (all_unbound) {
/* Preserve instances and default arguments */
LIST (TOKEN) d;
dargs = DEREF_list (tok_templ_dargs (sort));
d = expand_args (dargs, rec, 0);
if (!IS_NULL_list (d)) dargs = d;
}
ns = DEREF_nspace (tok_templ_pars (sort));
MAKE_tok_templ (ex, ns, sort);
COPY_list (tok_templ_pids (sort), q);
COPY_list (tok_templ_dargs (sort), dargs);
return (sort);
}
/*
* RESTORE A TEMPLATE SORT
*
* This routine is called at the end of the expansion of a template
* type to restore the sort produced by expand_templ_sort.
*/
void
reset_templ_sort(TOKEN sort)
{
UNUSED (sort);
return;
}
/*
* EXPAND AN EXPRESSION TOKEN
*
* This routine expands any token definitions in the expression e.
* rec gives the level of expansion, 0 for just the top level, 1 for a
* complete recursive expansion, and 2 for a recursive expansion of
* token parameters only. Negative values just return e.
*/
EXP
expand_exp(EXP e, int rec, int stmt)
{
unsigned etag;
if (rec < 0) return (e);
if (IS_NULL_exp (e)) return (NULL_exp);
etag = TAG_exp (e);
if (etag == exp_token_tag) {
/* Tokenised values */
TOKEN tok;
DECL_SPEC ds;
unsigned tag;
IDENTIFIER id = DEREF_id (exp_token_tok (e));
IDENTIFIER aid = DEREF_id (id_alias (id));
LIST (TOKEN) p = DEREF_list (exp_token_args (e));
if (!EQ_id (id, aid)) {
/* Replace token by its alias */
e = apply_exp_token (aid, p, 1);
id = aid;
}
ds = DEREF_dspec (id_storage (id));
tok = DEREF_tok (id_token_sort (id));
tag = TAG_tok (tok);
if (tag == tok_proc_tag) {
tok = DEREF_tok (tok_proc_res (tok));
tag = TAG_tok (tok);
}
if (rec) {
/* Expand token arguments */
p = expand_args (p, rec, 1);
e = apply_exp_token (id, p, rec);
}
/* if (rec == 2 && !(ds & dspec_auto)) break ; */
if (ds & dspec_temp) {
/* Check for recursive token expansions */
report (crt_loc, ERR_token_recursive (id));
return (make_error_exp (0));
}
COPY_dspec (id_storage (id), (ds | dspec_temp));
if (tag == tok_exp_tag) {
EXP a = DEREF_exp (tok_exp_value (tok));
if (!IS_NULL_exp (a)) {
/* Expand token definition */
e = expand_exp (a, rec, 0);
if (ds & dspec_auto) {
COPY_exp (tok_exp_value (tok), e);
}
}
} else if (tag == tok_stmt_tag) {
EXP a = DEREF_exp (tok_stmt_value (tok));
if (!IS_NULL_exp (a)) {
/* Expand token definition */
EXP b = get_parent_stmt (a);
e = expand_exp (a, rec, 1);
set_parent_stmt (e, b);
if (ds & dspec_auto) {
COPY_exp (tok_stmt_value (tok), e);
}
}
}
COPY_dspec (id_storage (id), ds);
} else if (etag == exp_int_lit_tag) {
/* Integer constants */
ERROR err = NULL_err;
NAT n1 = DEREF_nat (exp_int_lit_nat (e));
NAT n2 = expand_nat (n1, rec, 0, &err);
if (rec || !EQ_nat (n1, n2)) {
TYPE t = DEREF_type (exp_type (e));
unsigned tag = DEREF_unsigned (exp_int_lit_etag (e));
MAKE_exp_int_lit (t, n2, tag, e);
if (!IS_NULL_err (err)) report (crt_loc, err);
}
} else {
/* Other cases */
if (rec && !stmt) e = copy_exp (e, NULL_type, NULL_type);
}
return (e);
}
/*
* EXPAND AN INTEGER CONSTANT TOKEN
*
* This routine expands any token definitions in the integer constant
* expression n. rec is as above, ch is as in eval_exp.
*/
NAT
expand_nat(NAT n, int rec, int ch, ERROR *err)
{
if (rec < 0) return (n);
if (IS_NULL_nat (n)) return (NULL_nat);
switch (TAG_nat (n)) {
case nat_calc_tag : {
/* Calculated values */
EXP e2;
EXP e1 = DEREF_exp (nat_calc_value (n));
ulong tok = DEREF_ulong (nat_calc_tok (n));
if (rec) {
e2 = eval_exp (e1, ch);
} else {
e2 = expand_exp (e1, 0, 0);
}
e2 = convert_reference (e2, REF_NORMAL);
e2 = convert_lvalue (e2);
if (!EQ_exp (e1, e2) && !eq_exp_exact (e1, e2)) {
n = make_nat_exp (e2, err);
if (IS_nat_calc (n)) {
COPY_ulong (nat_calc_tok (n), tok);
}
}
break;
}
case nat_token_tag : {
/* Tokenised values */
TOKEN tok;
DECL_SPEC ds;
unsigned tag;
IDENTIFIER id = DEREF_id (nat_token_tok (n));
IDENTIFIER aid = DEREF_id (id_alias (id));
LIST (TOKEN) p = DEREF_list (nat_token_args (n));
if (!EQ_id (id, aid)) {
/* Replace token by its alias */
n = apply_nat_token (aid, p);
id = aid;
}
ds = DEREF_dspec (id_storage (id));
tok = DEREF_tok (id_token_sort (id));
tag = TAG_tok (tok);
if (tag == tok_proc_tag) {
if (rec) {
/* Expand token arguments */
p = expand_args (p, rec, 0);
if (!IS_NULL_list (p)) {
n = apply_nat_token (id, p);
}
}
tok = DEREF_tok (tok_proc_res (tok));
tag = TAG_tok (tok);
}
/* if (rec == 2 && !(ds & dspec_auto)) break ; */
if (ds & dspec_temp) {
/* Check for recursive token expansions */
report (crt_loc, ERR_token_recursive (id));
return (small_nat [1]);
}
COPY_dspec (id_storage (id), (ds | dspec_temp));
if (tag == tok_nat_tag || tag == tok_snat_tag) {
NAT m = DEREF_nat (tok_nat_etc_value (tok));
if (!IS_NULL_nat (m)) {
/* Expand token definition */
n = expand_nat (m, rec, ch, err);
if (ds & dspec_auto) {
COPY_nat (tok_nat_etc_value (tok), n);
}
}
}
COPY_dspec (id_storage (id), ds);
break;
}
}
return (n);
}
/*
* EXPAND A MEMBER TOKEN
*
* This routine expands any token definitions in the offset off. rec
* is as above.
*/
OFFSET
expand_offset(OFFSET off, int rec)
{
if (rec > 0) off = copy_offset (off, lex_plus);
return (off);
}
/*
* EXPAND A TEMPLATE TYPE
*
* This routine is a special case of expand_type which deals with
* template types.
*/
static TYPE
expand_templ_type(TYPE t, int rec)
{
CV_SPEC cv = DEREF_cv (type_qual (t));
TYPE s = DEREF_type (type_templ_defn (t));
TOKEN sort = DEREF_tok (type_templ_sort (t));
sort = expand_templ_sort (sort, rec);
if (IS_type_compound (s)) {
/* Template classes */
s = copy_class (s, dspec_instance);
} else {
/* Other template types */
s = expand_type (s, rec);
}
if (IS_NULL_tok (sort)) {
/* No unbound parameters */
t = qualify_type (s, cv, 0);
} else {
/* Unbound parameters - result is a specialisation */
MAKE_type_templ (cv, sort, s, 1, t);
}
reset_templ_sort (sort);
return (t);
}
/*
* EXPAND A LIST OF EXCEPTION TYPES
*
* This routine expands the list of exception types p, setting changed to
* true if any changes.
*/
LIST (TYPE)
expand_exceptions(LIST (TYPE) p, int rec, int *changed)
{
LIST (TYPE) q = NULL_list (TYPE);
if (EQ_list (p, univ_type_set)) {
q = p;
} else if (EQ_list (p, empty_type_set)) {
q = p;
} else {
while (!IS_NULL_list (p)) {
TYPE s1 = DEREF_type (HEAD_list (p));
TYPE s2 = expand_type (s1, rec);
if (!EQ_type (s1, s2)) {
s2 = check_except_type (s2, 0);
*changed = 1;
}
CONS_type (s2, q, q);
p = TAIL_list (p);
}
q = REVERSE_list (q);
}
return (q);
}
/*
* EXPAND A FUNCTION TYPE
*
* This routine is a special case of expand_type which deals with
* function types. rec will not be zero.
*/
static TYPE
expand_func_type(TYPE t, int rec)
{
int mf = 0;
int expanded = 0;
TYPE r1 = DEREF_type (type_func_ret (t));
TYPE r2;
LIST (TYPE) p1 = DEREF_list (type_func_ptypes (t));
LIST (TYPE) p2;
LIST (TYPE) m1 = DEREF_list (type_func_mtypes (t));
LIST (TYPE) m2 = NULL_list (TYPE);
LIST (TYPE) e1 = DEREF_list (type_func_except (t));
LIST (TYPE) e2;
if (!EQ_list (p1, m1)) {
if (!IS_NULL_list (m1) && EQ_list (p1, TAIL_list (m1))) {
/* Normal member function type */
mf = 1;
} else {
/* Swapped member function type */
mf = -1;
m1 = p1;
}
}
/* Copy return type */
r2 = expand_type (r1, rec);
if (!EQ_type (r1, r2)) expanded = 1;
/* Copy parameter types */
while (!IS_NULL_list (m1)) {
TYPE s1 = DEREF_type (HEAD_list (m1));
TYPE s2 = expand_type (s1, rec);
if (!EQ_type (s1, s2)) expanded = 1;
CONS_type (s2, m2, m2);
m1 = TAIL_list (m1);
}
m2 = REVERSE_list (m2);
/* Copy exception types */
e2 = expand_exceptions (e1, rec, &expanded);
/* Check for default arguments */
if (!expanded) {
LIST (IDENTIFIER) pids = DEREF_list (type_func_pids (t));
while (!IS_NULL_list (pids)) {
IDENTIFIER id = DEREF_id (HEAD_list (pids));
EXP e = DEREF_exp (id_parameter_init (id));
if (!IS_NULL_exp (e)) {
if (depends_on_exp (e, any_token_param, 0)) {
/* Needs expansion */
expanded = 1;
break;
}
}
pids = TAIL_list (pids);
}
}
/* Expand remaining items */
if (expanded) {
CV_SPEC cv = DEREF_cv (type_qual (t));
CV_SPEC mq = DEREF_cv (type_func_mqual (t));
int ell = DEREF_int (type_func_ellipsis (t));
NAMESPACE pars = DEREF_nspace (type_func_pars (t));
LIST (IDENTIFIER) pids = DEREF_list (type_func_pids (t));
LIST (IDENTIFIER) qids = NULL_list (IDENTIFIER);
/* Copy parameters */
while (!IS_NULL_list (pids)) {
TYPE s;
IDENTIFIER id = DEREF_id (HEAD_list (pids));
IDENTIFIER lid = chase_alias (id);
EXP e = DEREF_exp (id_parameter_init (id));
id = copy_id (id, 2);
COPY_id (id_alias (id), lid);
s = DEREF_type (id_parameter_type (id));
check_par_decl (s, id, CONTEXT_WEAK_PARAM);
if (!IS_NULL_exp (e)) {
/* Copy default argument */
EXP d;
e = expand_exp (e, rec, 0);
e = init_general (s, e, id, 0);
d = destroy_general (s, id);
COPY_exp (id_parameter_term (id), d);
COPY_exp (id_parameter_init (id), e);
}
CONS_id (id, qids, qids);
pids = TAIL_list (pids);
}
qids = REVERSE_list (qids);
/* Form function type */
if (mf == 0) {
p2 = m2;
} else if (mf == 1) {
p2 = TAIL_list (m2);
} else {
p2 = m2;
m2 = TAIL_list (p2);
}
MAKE_type_func (cv, NULL_type, p2, ell, mq, m2, pars, qids, e2, t);
t = inject_pre_type (t, r2, 0);
} else {
/* Free unused type lists */
if (!EQ_list (m2, m1)) DESTROY_list (m2, SIZE_type);
if (!EQ_list (e2, e1)) DESTROY_list (e2, SIZE_type);
}
return (t);
}
/*
* RESCAN A CLASS NAME
*
* This routine expands the class type ct by rescanning its name in the
* current context. It returns the null type if the result is not a
* type name.
*/
static TYPE
rescan_class(CLASS_TYPE ct)
{
IDENTIFIER cid = DEREF_id (ctype_name (ct));
TYPE t = find_typename (cid, NULL_list (TOKEN), btype_none, 1);
return (t);
}
/*
* RESCAN AN ENUMERATION NAME
*
* This routine expands the enumeration type et by rescanning its name
* in the current context. It returns the null type if the result is
* not a type name.
*/
static TYPE
rescan_enum(ENUM_TYPE et)
{
IDENTIFIER eid = DEREF_id (etype_name (et));
TYPE t = find_typename (eid, NULL_list (TOKEN), btype_none, 1);
return (t);
}
/*
* EXPAND A CLASS TYPE
*
* This routine expands any token definitions in the class type ct.
* rec is as above. The null class is returned if the result is not
* a class type with the actual type being assigned to pt.
*/
CLASS_TYPE
expand_ctype(CLASS_TYPE ct, int rec, TYPE *pt)
{
if (rec >= 0) {
TYPE s = NULL_type;
TYPE t = DEREF_type (ctype_form (ct));
if (!IS_NULL_type (t)) {
if (IS_type_token (t)) {
IDENTIFIER id = DEREF_id (type_token_tok (t));
LIST (TOKEN) p = DEREF_list (type_token_args (t));
if (IS_id_token (id)) {
/* Tokenised classes */
s = expand_type (t, rec);
} else if (rec) {
/* Template classes */
p = expand_args (p, rec, 0);
if (!IS_NULL_list (p)) {
/* Template class instance */
id = instance_type (id, p, 0, 1);
s = DEREF_type (id_class_name_defn (id));
while (IS_type_templ (s)) {
s = DEREF_type (type_templ_defn (s));
}
}
}
if (EQ_type (s, t)) {
/* No expansion possible */
return (ct);
}
} else if (IS_type_instance (t)) {
s = rescan_class (ct);
if (EQ_type (s, t)) {
/* No expansion possible */
return (ct);
}
} else {
/* Recursive template classes */
s = expand_type (t, rec);
}
} else {
CLASS_INFO ci = DEREF_cinfo (ctype_info (ct));
if (ci & cinfo_rescan) s = rescan_class (ct);
}
if (!IS_NULL_type (s)) {
if (IS_type_compound (s)) {
ct = DEREF_ctype (type_compound_defn (s));
} else {
*pt = s;
if (is_templ_type (s)) {
IDENTIFIER id = DEREF_id (type_token_tok (s));
ct = find_class (id);
} else {
ct = NULL_ctype;
}
}
}
}
return (ct);
}
/*
* BITFIELD EXPANSION FLAG
*
* This flag may be set to true to allow for zero sized bitfields in
* expand_type. The only way this can occur is in the expansion
* of an anonymous member type.
*/
int expand_anon_bitfield = 0;
/*
* EXPAND A TYPE TOKEN
*
* This routine expands any token definitions in the type t. rec is
* as above.
*/
TYPE
expand_type(TYPE t, int rec)
{
CV_SPEC cv;
int prom = 0;
IDENTIFIER id;
LIST (TOKEN) p;
if (rec < 0) return (t);
if (IS_NULL_type (t)) return (NULL_type);
cv = DEREF_cv (type_qual (t));
ASSERT (ORDER_type == 18);
switch (TAG_type (t)) {
case type_integer_tag : {
/* Integral types */
INT_TYPE it = DEREF_itype (type_integer_rep (t));
unsigned tag = TAG_itype (it);
if (tag == itype_arith_tag) {
/* Expand arithmetic types */
INT_TYPE ir = DEREF_itype (itype_arith_arg1 (it));
INT_TYPE is = DEREF_itype (itype_arith_arg2 (it));
TYPE r1 = DEREF_type (itype_prom (ir));
TYPE r2 = expand_type (r1, rec);
TYPE s1 = DEREF_type (itype_prom (is));
TYPE s2 = expand_type (s1, rec);
if (!EQ_type (r1, r2) || !EQ_type (s1, s2)) {
t = arith_type (r2, s2, NULL_exp, NULL_exp);
if (cv) t = qualify_type (t, cv, 0);
}
} else {
/* Expand other integral types */
if (tag == itype_promote_tag) {
it = DEREF_itype (itype_promote_arg (it));
tag = TAG_itype (it);
prom = 1;
}
if (tag == itype_token_tag) {
id = DEREF_id (itype_token_tok (it));
p = DEREF_list (itype_token_args (it));
goto expand_label;
}
if (tag == itype_basic_tag) {
/* Allow for special tokens */
BUILTIN_TYPE n = DEREF_ntype (itype_basic_no (it));
id = get_special (base_token [n].tok, 0);
if (!IS_NULL_id (id)) {
p = NULL_list (TOKEN);
goto expand_label;
}
}
}
break;
}
case type_floating_tag : {
/* Floating point types */
FLOAT_TYPE ft = DEREF_ftype (type_floating_rep (t));
unsigned tag = TAG_ftype (ft);
if (tag == ftype_arith_tag) {
/* Expand arithmetic types */
FLOAT_TYPE fr = DEREF_ftype (ftype_arith_arg1 (ft));
FLOAT_TYPE fs = DEREF_ftype (ftype_arith_arg2 (ft));
TYPE r1 = make_ftype (fr, NULL_ftype);
TYPE r2 = expand_type (r1, rec);
TYPE s1 = make_ftype (fs, NULL_ftype);
TYPE s2 = expand_type (s1, rec);
if (!EQ_type (r1, r2) || !EQ_type (s1, s2)) {
t = arith_type (r2, s2, NULL_exp, NULL_exp);
if (cv) t = qualify_type (t, cv, 0);
}
} else {
/* Expand other floating point types */
if (tag == ftype_arg_promote_tag) {
ft = DEREF_ftype (ftype_arg_promote_arg (ft));
tag = TAG_ftype (ft);
prom = 2;
}
if (tag == ftype_token_tag) {
id = DEREF_id (ftype_token_tok (ft));
p = DEREF_list (ftype_token_args (ft));
goto expand_label;
}
}
break;
}
case type_ptr_tag : {
/* Pointer types */
if (rec) {
TYPE s1 = DEREF_type (type_ptr_sub (t));
TYPE s2 = expand_type (s1, rec);
if (!EQ_type (s1, s2)) {
if (TAG_type (s1) == TAG_type (s2)) {
/* Don't check in this case */
MAKE_type_ptr (cv, s2, t);
} else {
MAKE_type_ptr (cv, NULL_type, t);
t = inject_pre_type (t, s2, 0);
}
}
}
break;
}
case type_ref_tag : {
/* Reference types */
if (rec) {
TYPE s1 = DEREF_type (type_ref_sub (t));
TYPE s2 = expand_type (s1, rec);
if (!EQ_type (s1, s2)) {
MAKE_type_ref (cv, NULL_type, t);
t = inject_pre_type (t, s2, 0);
}
}
break;
}
case type_ptr_mem_tag : {
/* Pointer to member types */
if (rec) {
TYPE r2 = NULL_type;
CLASS_TYPE c1 = DEREF_ctype (type_ptr_mem_of (t));
CLASS_TYPE c2 = expand_ctype (c1, rec, &r2);
TYPE s1 = DEREF_type (type_ptr_mem_sub (t));
TYPE s2 = expand_type (s1, rec);
if (!EQ_ctype (c1, c2)) {
if (IS_NULL_ctype (c2)) {
/* Illegal class type expansion */
report (crt_loc, ERR_dcl_mptr_class (r2));
MAKE_type_ptr (cv, NULL_type, t);
} else {
MAKE_type_ptr_mem (cv, c2, NULL_type, t);
}
t = inject_pre_type (t, s2, 0);
} else if (!EQ_type (s1, s2)) {
MAKE_type_ptr_mem (cv, c1, NULL_type, t);
t = inject_pre_type (t, s2, 0);
}
}
break;
}
case type_func_tag : {
/* Function types */
if (rec) t = expand_func_type (t, rec);
break;
}
case type_array_tag : {
/* Array types */
if (rec) {
ERROR err = NULL_err;
TYPE s1 = DEREF_type (type_array_sub (t));
TYPE s2 = expand_type (s1, rec);
NAT n1 = DEREF_nat (type_array_size (t));
NAT n2 = expand_nat (n1, rec, 0, &err);
if (!EQ_nat (n1, n2)) {
if (!IS_NULL_err (err)) {
ERROR err2 = ERR_dcl_array_dim_const ();
err = concat_error (err, err2);
report (crt_loc, err);
}
n2 = check_array_dim (n2);
MAKE_type_array (cv, NULL_type, n2, t);
t = inject_pre_type (t, s2, 0);
} else if (!EQ_type (s1, s2)) {
MAKE_type_array (cv, NULL_type, n2, t);
t = inject_pre_type (t, s2, 0);
}
}
break;
}
case type_bitfield_tag : {
/* Bitfield types */
if (rec) {
ERROR err = NULL_err;
INT_TYPE it = DEREF_itype (type_bitfield_defn (t));
TYPE s1 = DEREF_type (itype_bitfield_sub (it));
NAT n1 = DEREF_nat (itype_bitfield_size (it));
TYPE s2 = expand_type (s1, rec);
NAT n2 = expand_nat (n1, rec, 0, &err);
if (!EQ_type (s1, s2) || !EQ_nat (n1, n2)) {
BASE_TYPE rep;
int anon = expand_anon_bitfield;
rep = DEREF_btype (itype_bitfield_rep (it));
if (!IS_NULL_err (err)) {
ERROR err2 = ERR_class_bit_dim_const ();
err = concat_error (err, err2);
report (crt_loc, err);
}
rep = get_bitfield_rep (s2, rep);
t = check_bitfield_type (cv, s2, rep, n2, anon);
}
}
break;
}
case type_compound_tag : {
/* Class types */
CLASS_TYPE ct = DEREF_ctype (type_compound_defn (t));
TYPE s = DEREF_type (ctype_form (ct));
if (!IS_NULL_type (s)) {
if (IS_type_token (s)) {
/* Tokenised and template classes */
id = DEREF_id (type_token_tok (s));
p = DEREF_list (type_token_args (s));
if (IS_id_token (id)) goto expand_label;
if (rec) {
p = expand_args (p, rec, 0);
if (!IS_NULL_list (p)) {
/* Template class instance */
id = instance_type (id, p, 0, 1);
t = DEREF_type (id_class_name_defn (id));
while (IS_type_templ (t)) {
t = DEREF_type (type_templ_defn (t));
}
if (cv) t = qualify_type (t, cv, 0);
}
}
} else if (IS_type_instance (s)) {
s = rescan_class (ct);
if (!IS_NULL_type (s)) {
t = s;
if (cv) t = qualify_type (t, cv, 0);
}
} else {
/* Recursive template classes */
t = expand_type (s, rec);
if (cv) t = qualify_type (t, cv, 0);
}
} else {
CLASS_INFO ci = DEREF_cinfo (ctype_info (ct));
if (ci & cinfo_rescan) {
/* Force rescan */
s = rescan_class (ct);
if (!IS_NULL_type (s)) {
t = s;
if (cv) t = qualify_type (t, cv, 0);
}
}
}
break;
}
case type_enumerate_tag : {
/* Enumeration types */
ENUM_TYPE et = DEREF_etype (type_enumerate_defn (t));
CLASS_INFO ei = DEREF_cinfo (etype_info (et));
if (ei & cinfo_rescan) {
/* Force rescan */
TYPE s = rescan_enum (et);
if (!IS_NULL_type (s)) {
t = s;
if (cv) t = qualify_type (t, cv, 0);
}
}
break;
}
case type_token_tag : {
/* Tokenised types */
id = DEREF_id (type_token_tok (t));
p = DEREF_list (type_token_args (t));
expand_label : {
TOKEN tok;
unsigned tag;
DECL_SPEC ds;
IDENTIFIER aid;
int changed = 0;
if (!IS_id_token (id)) break;
aid = DEREF_id (id_alias (id));
if (!EQ_id (id, aid)) {
/* Replace token by its alias */
t = apply_type_token (aid, p, NULL_id);
changed = 1;
id = aid;
}
ds = DEREF_dspec (id_storage (id));
tok = DEREF_tok (id_token_sort (id));
tag = TAG_tok (tok);
if (tag == tok_proc_tag) {
if (rec) {
/* Expand token arguments */
p = expand_args (p, rec, 0);
if (!IS_NULL_list (p)) {
t = apply_type_token (id, p, NULL_id);
changed = 1;
}
}
tok = DEREF_tok (tok_proc_res (tok));
tag = TAG_tok (tok);
}
/* if (rec == 2 && !(ds & dspec_auto)) break ; */
if (ds & dspec_temp) {
/* Check for recursive token expansions */
report (crt_loc, ERR_token_recursive (id));
return (type_error);
}
COPY_dspec (id_storage (id), (ds | dspec_temp));
if (tag == tok_type_tag) {
/* Tokenised type */
TYPE s = DEREF_type (tok_type_value (tok));
if (!IS_NULL_type (s)) {
/* Expand token definition */
t = expand_type (s, rec);
if (ds & dspec_auto) {
COPY_type (tok_type_value (tok), t);
}
changed = 1;
} else {
BASE_TYPE bt;
bt = DEREF_btype (tok_type_kind (tok));
if (bt & btype_typename) {
/* Allow for typename */
s = find_typename (id, p, bt, 0);
if (!IS_NULL_type (s)) {
t = expand_type (s, rec);
changed = 1;
}
}
}
} else if (tag == tok_class_tag) {
/* Template template parameter */
aid = DEREF_id (tok_class_value (tok));
if (!IS_NULL_id (aid) && rec) {
p = expand_args (p, rec, 1);
aid = apply_template (aid, p, 0, 0);
if (IS_id_class_name_etc (aid)) {
t = DEREF_type (id_class_name_etc_defn (aid));
changed = 1;
}
}
}
if (changed) {
/* Qualify modified type */
if (prom == 1) {
t = promote_type (t);
} else if (prom == 2) {
t = arg_promote_type (t, KILL_err);
}
if (cv) {
CV_SPEC qual = DEREF_cv (type_qual (t));
t = qualify_type (t, (qual | cv), 0);
}
}
COPY_dspec (id_storage (id), ds);
}
break;
}
case type_templ_tag : {
/* Template types */
t = expand_templ_type (t, rec);
break;
}
}
return (t);
}
/*
* APPLY AN EXPRESSION TOKEN
*
* This routine applies the expression, statement or integer constant
* token id to the arguments args. If rec is true then the result
* type is expanded.
*/
EXP
apply_exp_token(IDENTIFIER id, LIST (TOKEN) args, int rec)
{
EXP e;
int is_proc = 0;
TOKEN tok = DEREF_tok (id_token_sort (id));
unsigned tag = TAG_tok (tok);
if (tag == tok_func_tag) {
tok = func_proc_token (tok);
tag = TAG_tok (tok);
}
if (tag == tok_proc_tag) {
is_proc = 1;
tok = DEREF_tok (tok_proc_res (tok));
tag = TAG_tok (tok);
}
switch (tag) {
case tok_exp_tag : {
/* Expression tokens */
int pt = in_proc_token;
TYPE t = DEREF_type (tok_exp_type (tok));
int c = DEREF_int (tok_exp_constant (tok));
if (rec > 0) {
t = expand_type (t, rec);
} else if (pt) {
in_proc_token = 0;
t = expand_type (t, 2);
in_proc_token = pt;
}
t = convert_qual_type (t);
MAKE_exp_token (t, id, args, e);
if (c) {
/* Check for integer constant tokens */
unsigned tt = TAG_type (t);
if (tt == type_integer_tag || tt == type_enumerate_tag) {
NAT n;
MAKE_nat_calc (e, n);
MAKE_exp_int_lit (t, n, exp_token_tag, e);
}
} else {
/* Allow for exceptions */
if (is_proc) {
IGNORE check_throw (NULL_type, 0);
}
}
break;
}
case tok_stmt_tag : {
/* Statement tokens */
MAKE_exp_token (type_void, id, args, e);
while (!IS_NULL_list (args)) {
TOKEN arg = DEREF_tok (HEAD_list (args));
if (IS_tok_stmt (arg)) {
/* Set parent statement for arguments */
EXP a = DEREF_exp (tok_stmt_value (arg));
set_parent_stmt (a, e);
}
args = TAIL_list (args);
}
IGNORE check_throw (NULL_type, 0);
break;
}
case tok_nat_tag :
case tok_snat_tag : {
/* Integer constant tokens */
NAT n;
MAKE_nat_token (id, args, n);
MAKE_exp_int_lit (type_sint, n, exp_token_tag, e);
break;
}
default : {
/* Other tokens */
e = NULL_exp;
break;
}
}
return (e);
}
/*
* APPLY AN INTEGER CONSTANT TOKEN
*
* This routine applies the integer constant token id to the arguments args.
*/
NAT
apply_nat_token(IDENTIFIER id, LIST (TOKEN) args)
{
NAT n;
TOKEN tok = DEREF_tok (id_token_sort (id));
unsigned tag = TAG_tok (tok);
if (tag == tok_proc_tag) {
tok = DEREF_tok (tok_proc_res (tok));
tag = TAG_tok (tok);
}
if (tag == tok_nat_tag || tag == tok_snat_tag) {
MAKE_nat_token (id, args, n);
} else {
n = NULL_nat;
}
return (n);
}
/*
* APPLY A BUILT-IN TYPE TOKEN
*
* Certain language extensions are implemented as built-in tokens (see
* define_keyword). This routine applies such a token, given by the
* keyword lex, to the arguments args.
*/
static TYPE
key_type_token(int lex, LIST (TOKEN) args)
{
TYPE t = NULL_type;
switch (lex) {
case lex_representation : {
TOKEN arg = DEREF_tok (HEAD_list (args));
t = DEREF_type (tok_type_value (arg));
if (!IS_NULL_type (t) && IS_type_integer (t)) {
TYPE s;
args = TAIL_list (args);
arg = DEREF_tok (HEAD_list (args));
s = DEREF_type (tok_type_value (arg));
if (!IS_NULL_type (s) && IS_type_integer (s)) {
INT_TYPE it = DEREF_itype (type_integer_rep (t));
INT_TYPE is = DEREF_itype (type_integer_rep (s));
t = make_itype (it, is);
}
}
break;
}
case lex_typeof : {
TOKEN arg = DEREF_tok (HEAD_list (args));
EXP e = DEREF_exp (tok_exp_value (arg));
if (!IS_NULL_exp (e)) {
t = DEREF_type (exp_type (e));
if (IS_type_bitfield (t)) {
t = promote_type (t);
}
}
break;
}
}
return (t);
}
/*
* APPLY A TYPE TOKEN
*
* This routine applies the type token id to the arguments args. tid
* gives the name, if any, to be given to any class created.
*/
TYPE
apply_type_token(IDENTIFIER id, LIST (TOKEN) args, IDENTIFIER tid)
{
TYPE t;
int pt = in_proc_token;
TOKEN tok = DEREF_tok (id_token_sort (id));
unsigned tag = TAG_tok (tok);
if (tag == tok_proc_tag) {
int lex = DEREF_int (tok_proc_key (tok));
if (lex != lex_identifier) {
t = key_type_token (lex, args);
if (!IS_NULL_type (t)) return (t);
}
tok = DEREF_tok (tok_proc_res (tok));
tag = TAG_tok (tok);
}
if (tag == tok_type_tag) {
BASE_TYPE bt = DEREF_btype (tok_type_kind (tok));
if (bt & btype_scalar) {
/* Scalar types */
t = apply_itype_token (id, args);
} else if (bt & btype_named) {
/* Structure and union types */
TYPE s;
CLASS_TYPE ct;
CLASS_INFO ci;
int tq = crt_templ_qualifier;
QUALIFIER cq = crt_id_qualifier;
int td = have_type_declaration;
if (IS_NULL_id (tid)) {
/* Make up class name if necessary */
HASHID tnm = lookup_anon ();
tid = DEREF_id (hashid_id (tnm));
}
/* Define the class */
crt_id_qualifier = qual_none;
crt_templ_qualifier = 0;
tid = begin_class_defn (tid, bt, cinfo_token, NULL_type);
if (IS_NULL_list (args)) {
COPY_id (id_token_alt (id), tid);
}
t = DEREF_type (id_class_name_etc_defn (tid));
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));
ci &= ~cinfo_empty;
COPY_cinfo (ctype_info (ct), ci);
MAKE_type_token (cv_none, id, args, s);
COPY_type (ctype_form (ct), s);
in_class_defn++;
really_in_class_defn++;
IGNORE end_class_defn (tid);
really_in_class_defn--;
in_class_defn--;
have_type_declaration = td;
crt_templ_qualifier = tq;
crt_id_qualifier = cq;
} else {
/* Generic types */
MAKE_type_token (cv_none, id, args, t);
}
} else {
/* Shouldn't occur */
t = type_error;
}
if (pt) {
/* Expand token arguments */
in_proc_token = 0;
t = expand_type (t, 2);
in_proc_token = pt;
}
return (t);
}
/*
* APPLY A MEMBER TOKEN
*
* This routine applies the member token id to the arguments args.
*/
OFFSET
apply_mem_token(IDENTIFIER id, LIST (TOKEN) args)
{
OFFSET off;
MAKE_off_token (id, args, off);
return (off);
}
/*
* APPLY A TOKEN
*
* This routine applies the token id to the arguments args.
*/
TOKEN
apply_token(IDENTIFIER id, LIST (TOKEN) args)
{
TOKEN tok = NULL_tok;
TOKEN sort = DEREF_tok (id_token_sort (id));
unsigned tag = TAG_tok (sort);
if (tag == tok_proc_tag) {
sort = DEREF_tok (tok_proc_res (sort));
tag = TAG_tok (sort);
}
switch (tag) {
case tok_exp_tag : {
EXP e = apply_exp_token (id, args, 0);
TYPE t = DEREF_type (exp_type (e));
int c = DEREF_int (tok_exp_constant (sort));
MAKE_tok_exp (t, c, e, tok);
break;
}
case tok_nat_tag :
case tok_snat_tag : {
NAT n = apply_nat_token (id, args);
MAKE_tok_nat_etc (tag, n, tok);
break;
}
case tok_stmt_tag : {
EXP e = apply_exp_token (id, args, 0);
MAKE_tok_stmt (e, tok);
break;
}
case tok_type_tag : {
TYPE t;
BASE_TYPE bt = DEREF_btype (tok_type_kind (sort));
t = apply_type_token (id, args, NULL_id);
MAKE_tok_type (bt, t, tok);
break;
}
case tok_member_tag : {
TYPE s = DEREF_type (tok_member_of (sort));
TYPE t = DEREF_type (tok_member_type (sort));
OFFSET off = apply_mem_token (id, args);
MAKE_tok_member (s, t, off, tok);
break;
}
case tok_class_tag : {
TYPE t = DEREF_type (tok_class_type (sort));
MAKE_tok_class (t, id, tok);
break;
}
}
return (tok);
}
/*
* COMPARE TWO TOKENS
*
* This routine compares the token sorts a and b.
*/
static int
eq_tok(TOKEN a, TOKEN b)
{
/* Check for obvious equality */
unsigned na, nb;
if (EQ_tok (a, b)) return (1);
if (IS_NULL_tok (a)) return (0);
if (IS_NULL_tok (b)) return (0);
/* Compare tags */
na = TAG_tok (a);
nb = TAG_tok (b);
if (na != nb) return (0);
/* Compare token components */
ASSERT (ORDER_tok == 10);
switch (na) {
case tok_exp_tag : {
/* Expression tokens */
TYPE ta = DEREF_type (tok_exp_type (a));
TYPE tb = DEREF_type (tok_exp_type (b));
CV_SPEC qa = DEREF_cv (type_qual (ta));
CV_SPEC qb = DEREF_cv (type_qual (tb));
int ca = DEREF_int (tok_exp_constant (a));
int cb = DEREF_int (tok_exp_constant (b));
return (ca == cb && qa == qb && eq_type (ta, tb));
}
case tok_nat_tag :
case tok_snat_tag :
case tok_stmt_tag : {
/* Trivial cases */
break;
}
case tok_func_tag : {
/* Function tokens */
TYPE ta = DEREF_type (tok_func_type (a));
TYPE tb = DEREF_type (tok_func_type (b));
return (eq_type (ta, tb));
}
case tok_member_tag : {
/* Member tokens */
TYPE sa = DEREF_type (tok_member_of (a));
TYPE sb = DEREF_type (tok_member_of (b));
TYPE ta = DEREF_type (tok_member_type (a));
TYPE tb = DEREF_type (tok_member_type (b));
return (eq_type (sa, sb) && eq_type (ta, tb));
}
case tok_proc_tag : {
/* Procedure tokens */
LIST (IDENTIFIER) pa, pb;
TOKEN ra = DEREF_tok (tok_proc_res (a));
TOKEN rb = DEREF_tok (tok_proc_res (b));
if (!eq_tok (ra, rb)) return (0);
/* Compare program parameters */
pa = DEREF_list (tok_proc_pids (a));
pb = DEREF_list (tok_proc_pids (b));
if (LENGTH_list (pa) != LENGTH_list (pb)) return (0);
while (!IS_NULL_list (pa) && !IS_NULL_list (pb)) {
IDENTIFIER u = DEREF_id (HEAD_list (pa));
IDENTIFIER v = DEREF_id (HEAD_list (pb));
if (IS_NULL_id (u) || !IS_id_token (u)) return (0);
if (IS_NULL_id (v) || !IS_id_token (v)) return (0);
ra = DEREF_tok (id_token_sort (u));
rb = DEREF_tok (id_token_sort (v));
if (!eq_tok (ra, rb)) return (0);
pa = TAIL_list (pa);
pb = TAIL_list (pb);
}
/* Compare bound parameters */
pa = DEREF_list (tok_proc_bids (a));
pb = DEREF_list (tok_proc_bids (b));
if (LENGTH_list (pa) != LENGTH_list (pb)) return (0);
while (!IS_NULL_list (pa) && !IS_NULL_list (pb)) {
IDENTIFIER u = DEREF_id (HEAD_list (pa));
IDENTIFIER v = DEREF_id (HEAD_list (pb));
if (IS_NULL_id (u) || !IS_id_token (u)) return (0);
if (IS_NULL_id (v) || !IS_id_token (v)) return (0);
ra = DEREF_tok (id_token_sort (u));
rb = DEREF_tok (id_token_sort (v));
if (!eq_tok (ra, rb)) return (0);
pa = TAIL_list (pa);
pb = TAIL_list (pb);
}
break;
}
case tok_type_tag : {
/* Type tokens */
BASE_TYPE ta = DEREF_btype (tok_type_kind (a));
BASE_TYPE tb = DEREF_btype (tok_type_kind (b));
if (ta != tb) return (0);
break;
}
case tok_class_tag : {
/* Template class tokens */
TYPE ta = DEREF_type (tok_class_type (a));
TYPE tb = DEREF_type (tok_class_type (b));
if (eq_type (ta, tb) == 1) return (1);
return (0);
}
case tok_templ_tag : {
/* Templates */
/* NOT YET IMPLEMENTED */
return (0);
}
}
return (1);
}
/*
* DECLARE A TOKEN IDENTIFIER
*
* This routine declares a token identifier id with sort tok and external
* name ext in the namespace ns.
*/
static IDENTIFIER
declare_token(IDENTIFIER id, TOKEN tok, NAMESPACE ns, IDENTIFIER ext)
{
HASHID nm = DEREF_hashid (id_name (id));
MEMBER mem = search_member (ns, nm, 1);
/* Check identifier name */
ERROR err = check_id_name (id, CONTEXT_OBJECT);
if (!IS_NULL_err (err)) report (crt_loc, err);
/* Check for previous definition */
id = DEREF_id (member_id (mem));
if (!IS_NULL_id (id)) {
id = redecl_inherit (id, qual_none, 0, 0);
if (!IS_NULL_id (id)) {
if (IS_id_token (id)) {
/* Allow for redeclarations */
IDENTIFIER tid = DEREF_id (id_token_alt (id));
if (EQ_id (tid, ext)) return (id);
}
if (IS_id_function (id) && IS_tok_proc (tok)) {
IDENTIFIER pid = id;
while (!IS_NULL_id (pid)) {
TYPE t = DEREF_type (id_function_type (pid));
if (IS_type_func (t)) {
TOKEN ptok;
MAKE_tok_func (t, ptok);
ptok = func_proc_token (ptok);
if (eq_tok (ptok, tok)) {
/* Procedure token matches function */
return (pid);
}
}
pid = DEREF_id (id_function_over (pid));
}
}
}
}
/* Declare the token */
MAKE_id_token (nm, dspec_token, ns, preproc_loc, tok, ext, id);
set_member (mem, id);
return (id);
}
/*
* DECLARE AN EXTERNAL TOKEN
*
* This routine declares a token of sort tok with internal name id,
* which belongs to the tag namespace if tag is true, and external name
* ext. It returns the external token identifier.
*/
IDENTIFIER
make_token_decl(TOKEN tok, int tag, IDENTIFIER id, IDENTIFIER ext)
{
int tq;
HASHID nm;
MEMBER mem;
unsigned tt;
QUALIFIER cq;
NAMESPACE ns;
NAMESPACE gns;
int macro = 0;
int pushed = 0;
int done_dump = 0;
IDENTIFIER tid = NULL_id;
DECL_SPEC ds = dspec_token;
DECL_SPEC mark = dspec_token;
/* Ignore illegal tokens */
if (IS_NULL_tok (tok)) return (NULL_id);
/* Find token name */
if (!IS_NULL_id (ext)) {
/* Externally named token */
ns = token_namespace;
/* gns = global_namespace ; */
gns = nonblock_namespace;
nm = DEREF_hashid (id_name (ext));
mem = search_member (ns, nm, 1);
ext = DEREF_id (member_id (mem));
if (!IS_NULL_id (ext)) {
TOKEN tok2 = DEREF_tok (id_token_sort (ext));
force_tokdef++;
if (!eq_tok (tok, tok2)) {
ERROR err = ERR_token_redecl (ext, id_loc (ext));
report (preproc_loc, err);
ext = NULL_id;
}
force_tokdef--;
}
if (IS_hashid_anon (nm)) {
ds |= dspec_static;
} else {
ds |= dspec_extern;
}
} else {
/* Token parameter */
ns = crt_namespace;
gns = ns;
nm = DEREF_hashid (id_name (id));
mem = NULL_member;
ds |= (dspec_auto | dspec_pure);
}
/* Create the token */
if (IS_NULL_id (ext)) {
IDENTIFIER uid = underlying_id (id);
MAKE_id_token (nm, ds, ns, preproc_loc, tok, uid, ext);
if (!IS_NULL_member (mem)) {
COPY_id (member_id (mem), ext);
}
}
/* Declare the corresponding identifier */
cq = crt_id_qualifier;
tq = crt_templ_qualifier;
crt_id_qualifier = qual_none;
crt_templ_qualifier = 0;
if (!EQ_nspace (gns, crt_namespace)) {
push_namespace (gns);
pushed = 1;
}
tt = TAG_tok (tok);
if (tt == tok_type_tag) {
BASE_TYPE bt = DEREF_btype (tok_type_kind (tok));
if (bt & btype_named) {
/* Allow structure and union tags */
if (tag) tid = id;
} else {
tag = 0;
}
} else {
/* Other tags are not allowed */
tag = 0;
}
switch (tt) {
case tok_type_tag : {
/* Simple type tokens */
TYPE t = apply_type_token (ext, NULL_list (TOKEN), tid);
if (tag) {
CLASS_TYPE ct = DEREF_ctype (type_compound_defn (t));
id = DEREF_id (ctype_name (ct));
done_dump = 1;
} else {
id = make_object_decl (dspec_typedef, t, id, 0);
if (!(ds & dspec_auto)) macro = 2;
}
break;
}
case tok_func_tag : {
/* Function tokens (C linkage by default) */
TYPE t = DEREF_type (tok_func_type (tok));
int ell = DEREF_int (type_func_ellipsis (t));
DECL_SPEC ln = crt_linkage;
if (ln == dspec_none) crt_linkage = dspec_c;
id = make_func_decl (dspec_extern, t, id, 0);
IGNORE init_object (id, NULL_exp);
if (IS_id_function_etc (id) && ell == FUNC_NONE) {
TYPE form;
MAKE_type_token (cv_none, ext, NULL_list (TOKEN), form);
COPY_type (id_function_etc_form (id), form);
if (!(ds & dspec_auto)) macro = 1;
if (is_redeclared) {
/* Mark functions which have already been declared */
ds |= dspec_explicit;
COPY_dspec (id_storage (ext), ds);
}
} else {
/* Ellipsis functions are not really tokenised */
mark = dspec_none;
}
crt_linkage = ln;
break;
}
case tok_member_tag : {
/* Member tokens */
int pt = in_proc_token;
CLASS_TYPE cs = crt_class;
TYPE t = DEREF_type (tok_member_of (tok));
CLASS_TYPE ct = DEREF_ctype (type_compound_defn (t));
NAMESPACE cns = DEREF_nspace (ctype_member (ct));
crt_class = ct;
in_class_defn++;
really_in_class_defn++;
push_namespace (cns);
t = DEREF_type (tok_member_type (tok));
if (pt) {
in_proc_token = 0;
t = expand_type (t, 2);
in_proc_token = pt;
}
id = make_member_decl (dspec_token, t, id, 0);
if (IS_id_member (id)) {
OFFSET off = DEREF_off (id_member_off (id));
if (!IS_NULL_off (off)) {
t = DEREF_type (id_member_type (id));
IGNORE define_mem_token (ext, off, t, 1);
if (!IS_NULL_member (mem)) {
if (IS_off_member (off)) {
/* Record old member name */
IDENTIFIER pid;
pid = DEREF_id (off_member_id (off));
COPY_id (member_alt (mem), pid);
}
}
}
off = apply_mem_token (ext, NULL_list (TOKEN));
COPY_off (id_member_off (id), off);
if (!(ds & dspec_auto)) macro = 2;
}
IGNORE pop_namespace ();
really_in_class_defn--;
in_class_defn--;
crt_class = cs;
break;
}
case tok_class_tag : {
/* Template template parameters */
TYPE t;
TYPE q = DEREF_type (tok_class_type (tok));
MAKE_type_token (cv_none, ext, NULL_list (TOKEN), t);
id = make_object_decl (dspec_typedef, t, id, 0);
t = inject_pre_type (q, t, 0);
COPY_type (id_class_name_etc_defn (id), t);
COPY_type (tok_class_type (tok), t);
mark |= dspec_template;
break;
}
default : {
/* Other tokens */
decl_loc = preproc_loc;
id = declare_token (id, tok, gns, ext);
if (IS_id_function (id)) {
TYPE form;
MAKE_type_token (cv_none, ext, NULL_list (TOKEN), form);
COPY_type (id_function_form (id), form);
}
if (!(ds & dspec_auto)) macro = 1;
break;
}
}
if (mark) {
/* Mark object as a token */
ds = DEREF_dspec (id_storage (id));
ds |= mark;
COPY_dspec (id_storage (id), ds);
}
COPY_id (id_token_alt (ext), id);
if (!IS_NULL_member (mem)) {
IDENTIFIER pid = DEREF_id (member_alt (mem));
if (IS_NULL_id (pid)) COPY_id (member_alt (mem), id);
if (do_dump) {
if (!done_dump) dump_declare (id, &preproc_loc, 0);
dump_token (id, ext);
}
}
if (pushed) {
IGNORE pop_namespace ();
}
crt_templ_qualifier = tq;
crt_id_qualifier = cq;
/* Check for previous macro definition */
if (macro) {
IDENTIFIER mid;
nm = DEREF_hashid (id_name (id));
mid = DEREF_id (hashid_id (nm));
switch (TAG_id (mid)) {
case id_obj_macro_tag :
case id_func_macro_tag : {
LOCATION loc;
loc = preproc_loc;
DEREF_loc (id_loc (mid), preproc_loc);
ds = DEREF_dspec (id_storage (mid));
COPY_dspec (id_storage (mid), (ds | dspec_temp));
if (define_token_macro (id, mid)) {
ds |= dspec_used;
if (do_macro && do_usage) {
dump_use (mid, &loc, 1);
}
COPY_loc (id_loc (ext), preproc_loc);
no_declarations++;
}
COPY_dspec (id_storage (mid), ds);
preproc_loc = loc;
break;
}
}
}
return (ext);
}
/*
* FIND A TOKEN IDENTIFIER
*
* This routine finds the token identifier associated with the identifier
* id.
*/
static IDENTIFIER
find_token_aux(IDENTIFIER id)
{
switch (TAG_id (id)) {
case id_class_name_tag :
case id_class_alias_tag : {
/* Classes */
TYPE t = DEREF_type (id_class_name_etc_defn (id));
if (IS_type_compound (t)) {
CLASS_TYPE ct = DEREF_ctype (type_compound_defn (t));
t = DEREF_type (ctype_form (ct));
if (!IS_NULL_type (t) && IS_type_token (t)) {
id = DEREF_id (type_token_tok (t));
return (id);
}
}
break;
}
case id_type_alias_tag : {
/* Types */
TYPE t = DEREF_type (id_type_alias_defn (id));
if (IS_type_token (t)) {
id = DEREF_id (type_token_tok (t));
return (id);
}
break;
}
case id_function_tag :
case id_mem_func_tag :
case id_stat_mem_func_tag : {
/* Functions */
TYPE form = DEREF_type (id_function_etc_form (id));
if (!IS_NULL_type (form) && IS_type_token (form)) {
IDENTIFIER ext = DEREF_id (type_token_tok (form));
if (!IS_NULL_id (ext)) return (ext);
}
return (id);
}
case id_member_tag : {
/* Members */
OFFSET off = DEREF_off (id_member_off (id));
if (IS_off_token (off)) {
id = DEREF_id (off_token_tok (off));
return (id);
}
break;
}
case id_token_tag : {
/* Tokens */
IDENTIFIER alt = DEREF_id (id_token_alt (id));
if (IS_id_token (alt)) return (alt);
return (id);
}
}
return (id);
}
/*
* FIND AN EXTERNAL TOKEN IDENTIFIER
*
* This routine finds the external token corresponding to the identifier id.
* For functions this refers only to the function id itself and not to
* any overloading functions.
*/
IDENTIFIER
find_token(IDENTIFIER id)
{
MEMBER mem;
DECL_SPEC ds;
IDENTIFIER tid;
HASHID nm = DEREF_hashid (id_name (id));
if (IS_id_keyword_etc (id)) {
/* Rescan keywords */
id = find_id (nm);
}
ds = DEREF_dspec (id_storage (id));
if (ds & dspec_token) {
/* Deal with simple tokens */
tid = find_token_aux (id);
if (IS_id_token (tid)) {
ds = DEREF_dspec (id_storage (tid));
if (!(ds & dspec_auto)) return (tid);
}
}
/* Complex cases - check through token namespace */
id = DEREF_id (id_alias (id));
mem = DEREF_member (nspace_global_first (token_namespace));
while (!IS_NULL_member (mem)) {
tid = DEREF_id (member_alt (mem));
if (EQ_id (tid, id)) {
tid = DEREF_id (member_id (mem));
return (tid);
}
mem = DEREF_member (member_next (mem));
}
return (id);
}
/*
* FIND A TAG TOKEN IDENTIFIER
*
* This routine finds the token corresponding to the tag identifier id.
*/
IDENTIFIER
find_tag_token(IDENTIFIER id)
{
id = find_elaborate_type (id, btype_any, NULL_type, dspec_used);
return (id);
}
/*
* FIND A MEMBER TOKEN IDENTIFIER
*
* This routine finds the token corresponding to the member mid of cid.
*/
IDENTIFIER
find_mem_token(IDENTIFIER cid, IDENTIFIER mid)
{
if (IS_id_class_name_etc (cid)) {
TYPE t = DEREF_type (id_class_name_etc_defn (cid));
IDENTIFIER fid = tok_member (mid, t, 1);
if (!IS_NULL_id (fid)) return (fid);
return (mid);
}
report (preproc_loc, ERR_dcl_type_simple_undef (cid));
return (mid);
}
/*
* FIND AN EXTERNAL TOKEN IDENTIFIER
*
* This routine finds the token with external name given by id.
*/
IDENTIFIER
find_ext_token(IDENTIFIER id)
{
HASHID nm = DEREF_hashid (id_name (id));
id = search_id (token_namespace, nm, 0, 0);
if (IS_NULL_id (id)) id = DEREF_id (hashid_id (nm));
return (id);
}
/*
* FIND A FUNCTION TOKEN IDENTIFIER
*
* This routine is identical to find_token except that it does a primitive
* form of overload resolution on function tokens based on the number of
* arguments n. A value of UINT_MAX indicates that any number of
* parameters is allowed.
*/
IDENTIFIER
find_func_token(IDENTIFIER id, unsigned n)
{
if (IS_id_function_etc (id)) {
int no = 0;
IDENTIFIER tid = NULL_id;
IDENTIFIER fid = id;
while (!IS_NULL_id (fid)) {
TYPE form = DEREF_type (id_function_etc_form (fid));
if (!IS_NULL_type (form) && IS_type_token (form)) {
IDENTIFIER ext = DEREF_id (type_token_tok (form));
if (!IS_NULL_id (ext) && IS_id_token (ext)) {
if (n == (unsigned) UINT_MAX) {
tid = ext;
no++;
} else {
TYPE t;
int ell;
LIST (TYPE) p;
t = DEREF_type (id_function_etc_type (fid));
while (IS_type_templ (t)) {
t = DEREF_type (type_templ_defn (t));
}
p = DEREF_list (type_func_ptypes (t));
ell = DEREF_int (type_func_ellipsis (t));
if (LENGTH_list (p) == n) {
if (!(ell & FUNC_ELLIPSIS)) {
tid = ext;
no++;
}
}
}
}
}
fid = DEREF_id (id_function_etc_over (fid));
}
if (no > 1) report (preproc_loc, ERR_token_def_ambig (id));
return (tid);
}
return (find_token (id));
}
/*
* CURRENT INTERFACE METHOD
*
* This flag is used to record the current interface method. It gives the
* mapping of any '#pragma interface' to one of '#pragma define', '#pragma
* no_def' or '#pragma ignore'.
*/
int crt_interface = lex_no_Hdef;
/*
* PERFORM A TOKEN INTERFACE OPERATION
*
* This routine performs the token interface operation indicated by i
* (which will be lex_define, lex_no_Hdef, lex_ignore) on the token tid.
*/
static void
mark_interface(IDENTIFIER tid, int i)
{
DECL_SPEC ds = DEREF_dspec (id_storage (tid));
if (i == lex_define) {
/* Token must be defined */
ds |= dspec_static;
ds &= ~dspec_pure;
} else if (i == lex_no_Hdef) {
/* Token must not be defined */
ds |= dspec_pure;
if (ds & dspec_defn) {
/* Token already defined */
PTR (LOCATION) loc = id_loc (tid);
report (preproc_loc, ERR_token_no_def (tid, loc));
}
} else {
/* Ignore token definitions */
ds |= dspec_done;
ds &= ~dspec_pure;
}
COPY_dspec (id_storage (tid), ds);
return;
}
/*
* PERFORM A TOKEN INTERFACE OPERATION
*
* This routine looks up the token id and performs the token operation
* i on it. In addition to the values above i can be lex_undef indicating
* that the token should be undefined.
*/
void
token_interface(IDENTIFIER id, int i)
{
int ok = 0;
IDENTIFIER pid = id;
while (!IS_NULL_id (pid)) {
IDENTIFIER tid = find_token (pid);
if (IS_id_token (tid)) {
/* Token found */
if (i == lex_undef) {
if (do_dump) dump_undefine (pid, &preproc_loc, 1);
remove_id (pid);
} else {
mark_interface (tid, i);
}
ok = 1;
}
if (!IS_id_function_etc (pid)) break;
pid = DEREF_id (id_function_etc_over (pid));
}
if (!ok) {
/* Token not found */
report (preproc_loc, ERR_token_undecl (id));
}
return;
}
syntax highlighted by Code2HTML, v. 0.9.1