コード例 #1
0
ファイル: g0a.c プロジェクト: daveshields/AdaEd
static Node val_node3(Rational init_val)						/*;val_node3*/
{
	/* Called from init_sem to initialize the bounds of predefined types.*/

	Node node;

	node = node_new(as_ivalue);
	init_node_save(node);
	/* INTEGER TUPLE case */
	N_TYPE(node) = symbol_universal_real;

	N_VAL(node) =(char *) rat_const(init_val);
	return node;
}
コード例 #2
0
ファイル: g0a.c プロジェクト: daveshields/AdaEd
static Node val_nodea1(int init_val)							/*;val_nodea1*/
{
	/* Called from init_sem to initialize the bounds of predefined types.*/
	/* like val_node1, but does not save generated node */

	Node node;

	node = node_new(as_ivalue);
	/* INTEGER case */
	N_TYPE(node) = symbol_integer;

	N_VAL(node) =(char *) int_const(init_val);
	return node;
}
コード例 #3
0
ファイル: symbol_table.c プロジェクト: Alfandorachk/Tetra
void TTR_set_ident_data_type(
        Symbol_Table *table, TTR_Node *identifier, int type)
{
    TTR_Node *sym_node;

    assert(table != NULL);
    assert(identifier != NULL);
    assert(N_TYPE(identifier) == N_IDENTIFIER ||
            N_TYPE(identifier) == N_FUNCDEF);

    sym_node = symbol_table_lookup(table, N_STR(identifier));
    if (sym_node == NULL) {
        N_DTYPE(identifier) = type;
        symbol_table_add(table, N_STR(identifier), identifier);
    } else {
        if (N_DTYPE(sym_node) == UNDEFINED_T) {
            N_DTYPE(identifier) = type;
            N_DTYPE(sym_node) = type;
        } else {
            N_DTYPE(identifier) = N_DTYPE(sym_node);
        }
    }
}
コード例 #4
0
ファイル: g0a.c プロジェクト: daveshields/AdaEd
static Node val_node2(double init_val)						/*;val_node2*/
{
	/* Called from init_sem to initialize the bounds of predefined types.*/

	Node node;

	/* 'REAL' case */
	node = node_new(as_ivalue);
	init_node_save(node);

	N_TYPE(node) = symbol_float;

	N_VAL(node) = (char *)real_const(init_val);
	return node;
}
コード例 #5
0
ファイル: tetra.c プロジェクト: Alfandorachk/Tetra
void patch(void)
{
    TTR_Node *node, *stored;
    int type;

    SET_GLOBAL_SCOPE();
    for (   node = dll_pop_head(call_patch_list);
            node != NULL;
            node = dll_pop_head(call_patch_list)) {
        stored = GET_SYMBOL(N_STR(node));    
        if (stored == NULL) {
            fprintf(stderr, "<Line %d> Function \"%s\" never defined\n",
                    N_LINE(node), N_STR(node));
            err_exit("Fatal error");
        } else {
            N_DTYPE(node) = N_DTYPE(stored);
            if (COMPARE_TYPES(N_CHILD(stored, 0), N_CHILD(node, 0))) {
                fprintf(stderr, 
                        "<Line %d> Incompatible types in call to %s.\n",
                        N_LINE(node), N_STR(node));
                err_exit("Fatal error");
            }
        }
    }

    for (   node = dll_pop_head(var_patch_list);
            node != NULL;
            node = dll_pop_head(var_patch_list)) {
        SET_GLOBAL_SCOPE();
        ENTER_SCOPE(N_SCOPE(node));
        if (N_TYPE(node) == N_ASSIGN) {
            TTR_set_ident_data_type(symbol_table,
                    N_CHILD(node, 0), N_DTYPE(N_CHILD(node, 1)));
        }
        type = TTR_infer_data_type(node);
        if (type == INVALID_T) {
            fprintf(stderr, "<Line %d> Incompatible types.\n",
                    N_LINE(node));
            err_exit("Fatal error");
        } else if (type == UNDEFINED_T) {
            fprintf(stderr, "<Line %d> Unknown symbol.\n", N_LINE(node));
            print_tree(node, 0);
            err_exit("Fatal error");
        }
    }

}
コード例 #6
0
ファイル: 2.c プロジェクト: daveshields/AdaEd
void process_pragma(Node node)								/*;process_pragma*/
{
	/* This arbitrarily extensible procedure  processes pragma declarations.
	 * The name  of the  pragma  determines the way	 in which the  args  are
	 * processed. If no meaning has been attached to a pragma name, the user
	 * is notified, and the pragma is ignored.
	 */

	Node	id_node, arg_list_node, arg_node, i_node, e_node, arg1, arg2;
	Node	priority, marker_node, type_node;
	char	*id;
	Tuple	args, arg_list;
	Symbol	proc_name, p_type, id_sym;
	int		nat, exists, newnat;
	Fortup	ft1;
	Forset	fs1;

	if (cdebug2 > 3) TO_ERRFILE("AT PROC : process_pragma(node) ");

	id_node = N_AST1(node);
	arg_list_node = N_AST2(node);
	id = N_VAL(id_node);
	arg_list = N_LIST(arg_list_node);
	/*aix := []; */ /* Most pragmas generate no code.*/
	if (is_empty(arg_list)) {	/* pragma with no parameters */
		errmsg_str("Format error in pragma", id, "Appendices B, F", node);
	}
	else {
		/* Process list of arguments. */
		args = tup_new(0);
		FORTUP(arg_node = (Node), arg_list, ft1);
			i_node = N_AST1(arg_node);
			e_node = N_AST2(arg_node);
			adasem(e_node);
			/* For now, disregard named associations.*/
			args = tup_with(args, (char *) e_node);
		ENDFORTUP(ft1);

		if (streq(id, "IO_INTERFACE") ) {
			/* Current interface to predefined procedures (e.g. text_io).
			 * The pragma makes up the body of a predefined procedure.
			 * This body is formatted into a single tuple :
			 *
			 *		[ io_subprogram, marker , name1, name2...]
			 *
			 * where the marker is the  second argument  of the  pragma. This
			 * marker is  used as an	 internal switch by the tio interpreter.
			 * The remaining components of  the tuple are the unique names of
			 * the formal parameters of the procedure.The pragma must follow
			 * immediately the procedure spec to which it applies. The pragma
			 * then supplies the body for it.
			 */
			arg1 = (Node) args[1];
			/* The first argument in the pragma list is a string in the case
			 * of overloadable operators used in the CALENDAR package.
			 */
			if (N_KIND(arg1) == as_string_literal)
				id = N_VAL(arg1);
			else
				id = N_VAL(N_AST1(arg1));
			/* assert exists proc_name in overloads(declared(scope_name)(id))
			 *  | rmatch(nature(proc_name), '_spec') /= om;
			 */
			exists = FALSE;
			FORSET(proc_name = (Symbol),
			  OVERLOADS(dcl_get(DECLARED(scope_name), id)), fs1);
				nat = NATURE(proc_name);
				if (nat == na_procedure_spec  || nat == na_function_spec
			      || nat == na_task_obj_spec || nat == na_generic_procedure_spec
			      || nat == na_generic_function_spec 
			      || nat == na_generic_package_spec) {
					exists = TRUE;
					break;
				}
			ENDFORSET(fs1);
			if (exists == FALSE)
				warning("subprogram given in pragma not found", node);
			if (nat == na_procedure_spec  ) newnat = na_procedure;
			else if (nat == na_function_spec) newnat = na_function;
			else warning("argument to pragma is not a subprogram", node);
			NATURE(proc_name) = newnat;
			marker_node = N_AST1((Node)args[2]);
			if (tup_size(args) == 3 ) {
				type_node = (Node)args[3];
				find_old(type_node);
			}
			else
				type_node = OPT_NODE;
			N_KIND(node) = as_predef;
			N_UNQ(node) = proc_name;
			/* marker_node is an as_line_no node which carries the numerical 
			 * predef code corresponding to the entry in the pragma 
	 		 * IO_INTERFACE. as_line_no was used to simpify having the predef 
			 * code converted into a number by the parser and relayed here 
			 * as an integer.
			 */
			N_VAL(node) = N_VAL(marker_node);
			N_TYPE(node) = (type_node == OPT_NODE)? OPT_NAME : N_UNQ(type_node);
		}
		else if (streq(id, "INTERFACE") ) {
			/* Current interface to C and FORTRAN 
			 * The pragma makes up the body of a procedure.
			 * This body is formatted into a single tuple :
			 *
			 *		[language, name]
			 *
			 * where language is C or FORTRAN and name is the identifier 
			 * of the subprogram to be interfaced.
			 * This pragma is allowed at the place of a declarative item of
			 * the same declarative part or package specification. The pragma 
			 * is also allowed for a library unit; in this case, the pragma must
			 * appear after the subprogram decl, and before any subsequent
			 * compilation unit. 
			 */
			arg1 = (Node) args[1];
			/* The 1st arg in the pragma list is an identifier (C or FORTRAN) */
			if (N_KIND(arg1) != as_name) {
				warning("invalid format for pragma", node);
				return;
			}
			id = N_VAL(N_AST1(arg1));
			if (!streq(id, "C") && !streq(id, "FORTRAN")) {
				warning("invalid first argument for pragma", node);
				return;
			}

			arg2 = (Node) args[2];
			/* The 2nd argument in the pragma list is a subprogram identifier */
			if (N_KIND(arg2) != as_name) {
				warning("invalid format for pragma", node);
				return;
			}
			id = N_VAL(N_AST1(arg2));
			/* assert exists proc_name in overloads(declared(scope_name)(id))
			 *  | rmatch(nature(proc_name), '_spec') /= om;
			 */
			exists = FALSE;
			id_sym = dcl_get(DECLARED(scope_name), id);
			if (id_sym == (Symbol)0) {
				if (NATURE(scope_name)== na_private_part)
					/* check parent scope, which is scope of visible part */
					id_sym = dcl_get(DECLARED((Symbol)open_scopes[2]), id);
				if (id_sym == (Symbol)0) {
					warning("subprogram given in pragma not found", node);
					return;
				}
			}
			FORSET(proc_name = (Symbol), OVERLOADS(id_sym), fs1);
				nat = NATURE(proc_name);
				if (nat == na_procedure_spec) {
					newnat = na_procedure;
					exists = TRUE;
				}
				else if (nat == na_function_spec) {
					newnat = na_function;
					exists = TRUE;
				}
			ENDFORSET(fs1);
			if (!exists) {
				warning("invalid second argument to pragma", node);
				return;
			}

			NATURE(proc_name) = newnat;
			N_KIND(node) = as_interfaced;
			N_UNQ(node) = proc_name;
			N_AST1(node) = N_AST1(arg1);
		}

		else if (streq(id, "PRIORITY")) {
			Unitdecl ud;
			if (tup_size(args) == 1) {
				ud = unit_decl_get("spSYSTEM");
				if (ud == (Unitdecl)0 || !in_vis_mods(ud->ud_unam) ) {
					warning(
	  "use of PRIORITY without presence of package SYSTEM is ignored",
					  (Node)args[1]);
					N_KIND(node) = as_opt;
					N_AST1(node) = N_AST2(node) = N_AST3(node) = N_AST4(node)
					  = (Node)0;
					return;
				}
				else {
					p_type = dcl_get_vis(DECLARED(ud->ud_unam), "PRIORITY");
				}
				priority = (Node) args[1];
				check_type(p_type, priority);
				if (!is_static_expr(priority))
					warning("Priority must be static", priority);
			}
			else
				warning("Invalid format for pragma priority", node);
		}
		else if (streq(id, "CONTROLLED")
		  || streq(id, "INCLUDE")
		  || streq(id, "INLINE")
		  || streq(id, "LIST")
		  || streq(id, "MEMORY_SIZE")
		  || streq(id, "OPTIMIZE")
		  || streq(id, "PACK")
		  || streq(id, "STORAGE_UNIT")
		  || streq(id, "SUPRESS")
		  || streq(id, "SYSTEM") ) {
			warning("unsupported pragma", id_node);
		}
		else
			warning("unrecognized pragma", node);
	}
}
コード例 #7
0
ファイル: nam.c プロジェクト: daveshields/AdaEd
/* Object evaluation */
void gen_address(Node node)										/*;gen_address*/
{
	/*
	 *  This procedure generates code for the o_expressions
	 *  or, in other words, the left-handsides.
	 */

	Node   pre_node, array_node, range_node, lbd_node, ubd_node, record_node,
	  field_node, id_node;
	Symbol	node_name, type_name, record_name, record_type,
	  field_name, comp_type, proc_name, return_type;
	int		f_off, bse, off, nk;
	Fortup	ft1;

#ifdef TRACE
	if (debug_flag)
		gen_trace_node("GEN_ADDRESS", node);
#endif

	while (N_KIND(node) == as_insert) {
		FORTUP(pre_node=(Node), N_LIST(node), ft1);
			compile(pre_node);
		ENDFORTUP(ft1);
		node = N_AST1(node);
	}

	node_name = N_UNQ(node);
	if (is_simple_name(node)) {
		type_name = get_type(node);
		if (is_renaming(node_name))
			gen_ks(I_PUSH, mu_addr, node_name);
		else
			gen_s(I_PUSH_EFFECTIVE_ADDRESS, node_name);

		/* Arrays are treated in a different manner, depending on their */
		/* nature: parameters, constants, variables... */
		if (is_array_type(type_name)) {
			if (is_formal_parameter(node_name)) {
				type_name = assoc_symbol_get(node_name, FORMAL_TEMPLATE);
			}
			gen_s(I_PUSH_EFFECTIVE_ADDRESS, type_name);
		}

	}
	else {
		switch (nk = N_KIND(node)) {
		case as_raise:
			compile(node);
			break;

		case as_index:
			gen_subscript(node);
			break;

		case as_slice:
			array_node = N_AST1(node);
			range_node = N_AST2(node);
			/*range_name = N_UNQ(range_node); -- never used   ds 7-8-85 */

			/* Note: case of type simple name changed into range attribute */
			/* by expander */
			if (N_KIND(range_node) == as_attribute) {
				gen_attribute(range_node);
			}
			else { /* range */
				lbd_node = N_AST1(range_node);
				ubd_node = N_AST2(range_node);
				gen_value(lbd_node);
				gen_value(ubd_node);
			}
			if (N_KIND(array_node) == as_attribute) {
				gen_attribute(array_node);
			}
			else {
				gen_address(array_node);
			}
			gen(I_ARRAY_SLICE);
			break;

		case as_selector:
			record_node = N_AST1(node);
			field_node = N_AST2(node);
			record_name = N_UNQ(record_node);
			record_type = get_type(record_node);
			field_name = N_UNQ(field_node);
			f_off = FIELD_OFFSET(field_name);
			if (f_off >= 0 &&
			  ((! has_discriminant(record_type))
			  || NATURE(field_name) == na_discriminant)){
				if (is_simple_name(record_node)
				  && !(is_renaming(record_name)) && is_global(record_name)) {
					reference_of(record_name);
					bse = REFERENCE_SEGMENT;
					off = REFERENCE_OFFSET;
					/* The SETL version has generate(I_PUSH_IMMEDIATE, mu_addr,
					 *  ref, field_name);
					 * which we translate as (I_PUSH_EFFECTIVE_ADDRESS ...
					 * ref       = [bse, off+f_off];
					 * Replace use of explicit ref by PUSH_IMMEDIATE
					 */
					/*  gen_rc(I_PUSH_IMMEDIATE, explicit_ref_new(bse,
					 *   off+f_off), "");
					 */
					gen_kv(I_PUSH_IMMEDIATE, mu_word, int_const(bse));
					gen_kv(I_PUSH_IMMEDIATE, mu_word, int_const(off+f_off));
				}
				else {
					gen_address(record_node);
					if (f_off != 0 ) {
						gen_ki(I_ADD_IMMEDIATE, mu_word, f_off);
					}
				}
				if (is_array_type(comp_type=TYPE_OF(field_name))) {
					gen_s(I_PUSH_EFFECTIVE_ADDRESS, comp_type);
				}
			}
			else {
				gen_address(record_node);
				gen_s(I_PUSH_EFFECTIVE_ADDRESS, record_type);
				/* translating following assuming field_name is comment part of
				 *-- instruction		ds	7-5-86
				 * 		gen_i(I_SELECT, FIELD_NUMBER(field_name), field_name);
				 */
				gen_i(I_SELECT, (int) FIELD_NUMBER(field_name));
			}
			break;

		case as_all:
			id_node = N_AST1(node);
			gen_value(id_node);
			if (is_array_type(N_TYPE(node)))
				gen_k(I_DEREF, mu_dble);
			break;

		case as_call:
			id_node   = N_AST1(node);
			proc_name   = N_UNQ(id_node);
			return_type = TYPE_OF(proc_name);
			gen_kc(I_DUPLICATE, kind_of(return_type), "place holder");
			compile(node);  	 /* processed from now as a procedure call */
			break;

		case as_un_op:
			gen_unary(node);
			break;

		case as_op:
			gen_binary(node);
			break;

		case as_string_ivalue:
			gen_value(node);
			break;

		default:
			compiler_error_k("GEN_ADDRESS called with kind ", node);
		}
	}
}
コード例 #8
0
ファイル: initobj.c プロジェクト: daveshields/AdaEd
Node build_proc_init_ara(Symbol type_name)				/*;build_proc_init_ara*/
{
	/*
	 *  This is the   main procedure for  building default  initialization
	 *  procedures for array  types. Those  initialization  procedures are
	 *  built if  the type  given  contains  some subcomponent for which a
	 *  default initialization exists (at any level of nesting),  or if it
	 *  has determinants.
	 *  Note that scalar objects are not initialized at all, which implies
	 *  that they get whatever initial value is in that location in memory
	 *  This saves some time in object creation.
	 *
	 *  All init. procedures  have an 'out' parameter that  designates the
	 *  object being initialized (the space has already been allocated).
	 *
	 */

	int		side_effect;
	Tuple	tup, formals, subscripts;
	Symbol	c_type, ip, index_t, proc_name, index_sym;
	Node	one_component, init_stmt, out_param, i_nodes, d_node, iter_node;
	Fortup	ft1;
	Node	iterator, index_node;

#ifdef TRACE
	if (debug_flag) {
		gen_trace_symbol("BUILD_PROC_INIT_ARR", type_name);
	}
#endif

	side_effect = FALSE;	 /* Let's hope... TBSL */

	tup = SIGNATURE(type_name);
	c_type    = (Symbol) tup[2];
	one_component = new_node(as_index);

	ip = INIT_PROC(base_type(c_type));
	if (ip != (Symbol)0 ){
		/* Use the initialization procedure for the component type */
		init_stmt = (Node) build_init_call(one_component, ip, c_type, OPT_NODE);
	}
	else if (is_task_type(c_type)) {
		/* initialization is task creation. */
		init_stmt =
		  new_assign_node(one_component, new_create_task_node(c_type));
	}
	else if (is_access_type(c_type)) {
		/* default value is the null pointer. */
		init_stmt = new_assign_node(one_component, new_null_node(c_type));
	}
	else {
		init_stmt = (Node) 0;
	}

	if (init_stmt != (Node)0) {
		/* body of initialization procedure is a loop over the indices */
		/* allocating each component. Generate loop variables and code */
		/* for iteration, using the attributes of the type. */

		proc_name = new_unique_name("type_name+INIT");
		out_param = new_param_node("param_type_name", proc_name,
		   type_name, na_out);
		generate_object(N_UNQ(out_param));
		formals               = tup_new1((char *) out_param);
		subscripts            = tup_new(0);
		FORTUP(index_t=(Symbol), index_types(type_name), ft1);
			/*index          = index_t + 'INDEX';*/
			index_sym          = new_unique_name("index_t+INDEX");
			NATURE (index_sym) = na_obj;
			TYPE_OF(index_sym) = index_t;
			subscripts = tup_with(subscripts, (char *)new_name_node(index_sym));
		ENDFORTUP(ft1);

		i_nodes         = new_node(as_list);
		/* need tup_copy since subscripts used destructively below */
		N_LIST(i_nodes) = tup_copy(subscripts);

		/* Build the tree for the one_component of the array. */
		N_AST1(one_component) = out_param;
		N_AST2(one_component) = i_nodes;
		N_TYPE(one_component) = c_type;

		while (tup_size(subscripts)) {
			/* Build loop from innermost index outwards. The iterations */
			/* span the ranges of the array being initialized. */

			/* dimension spanned by this loop: */
			d_node   = new_ivalue_node(int_const(tup_size(subscripts)), 
			  symbol_integer);
			iterator = new_attribute_node(ATTR_O_RANGE,
			  new_name_node(N_UNQ(out_param)), d_node, type_name);

			index_node = (Node) tup_frome(subscripts);
			iter_node        = new_node(as_for);
			N_AST1(iter_node) = index_node;
			N_AST2(iter_node) = iterator;

			init_stmt = new_loop_node(OPT_NODE, iter_node, 
			  tup_new1((char *)init_stmt));
		}

		INIT_PROC(type_name) = proc_name;
		return initialization_proc(proc_name, type_name,
		  formals, tup_new1((char *) init_stmt));
	}
	else {
		return OPT_NODE;
	}

}
コード例 #9
0
ファイル: eval.c プロジェクト: daveshields/AdaEd
static Const const_fold(Node node)							/*;const_fold*/
{
	/* This recursive procedure evaluates expressions, when static.
	 * If node is static, its actual value	 is returned,  and the	node is
	 * modified to be an ivalue. Otherwise const_fold returns om, and node
	 * is	untouched. If the static  evaluation shows that the  expression
	 * would  raise an exception, a ['raise' exception] value  is produced
	 * and placed on the tree.
	 */

	Fortup ft1;
	Node expn, index_list, index, discr_range;
	Const	result;
	Node	opn;
	Node	n2, op_range;
	Symbol	sym, op_type;

	/* */
#define is_simple_value(t) ((t)->const_kind == CONST_INT \
	|| (t)->const_kind == CONST_UINT || (t)->const_kind == CONST_REAL)

	if (cdebug2 > 3) { }

	switch (N_KIND(node)) {
	case(as_simple_name):
		result = const_val(N_UNQ(node));
		break;
	case(as_ivalue):
		result = (Const) N_VAL(node);
		break;
	case(as_int_literal):
		/* TBSL: assuming int literal already converted check this Const*/
		result = (Const) N_VAL(node);
		break;
	case(as_real_literal):
		/*TBSL: assuming real literal already converted */
		result = (Const) N_VAL(node);
		break;
	case(as_string_ivalue):
		/* Will be static if required type has static low bound.*/
		/*		indx := index_type(N_TYPE(node));
		 *		[-, lo_exp, -] := signature(indx);
		 * * Move this test to the expander, once format of aggregates is known.
		 *		if is_static_expr(lo_exp) then
		 *		   lob := N_VAL(lo_exp);
		 *		   av  := [v : [-, v] in comp_list];
		 *		   result := check_null_aggregate(av, lob, indices, node);
		 *		   result := ['array_ivalue', [v: [-, v] in comp_list], 
		 *					   lob, lob + #comp_list - 1];
		 *		else
		 */
		result = const_new(CONST_OM);
		/*		end if;	*/
		break;
	case(as_character_literal):
		result = const_new(CONST_STR);
		break;
	case(as_un_op):
		result = fold_unop(node);
		break;
	case(as_in):
		opn = N_AST1(node);
		op_range = N_AST2(node);
		result = eval_qual_range(opn, N_TYPE(op_range));
		if (is_const_constraint_error(result))
			result = test_expr(FALSE);
		else if (!is_const_om(result))
			result = test_expr(TRUE);
		break;
	case(as_notin):
		opn = N_AST1(node);
		n2 = N_AST2(node);
		result = eval_qual_range(opn, N_TYPE(n2));
		if (is_const_constraint_error(result))
			result = test_expr(TRUE);
		else if (!is_const_constraint_error(result))
			result = test_expr(FALSE);
		break;
	case(as_op):
		result = fold_op(node);
		break;
	case(as_call):
		{
			int i;
			Tuple arg_list;
			Const arg;

			opn = N_AST1(node);
			result = const_new(CONST_OM);       /* in general not static */
			arg_list = N_LIST(N_AST2(node));    /* but can fold actuals. */
			for (i = 1; i <= tup_size(arg_list); i++)
				arg = const_fold((Node)arg_list[i]);
			if (N_KIND(opn) == as_simple_name) {
				sym = ALIAS(N_UNQ(opn));
				if (sym != (Symbol)0 && is_literal(sym))
					/* replace call by actual value of literal */
					result = eval_lit_map(sym);
			}
		}
		break;
	case(as_parenthesis):
		/* If the parenthesised expression is evaluable, return
		 * its value. Otherwise leave it parenthesised.
		 */
		opn = N_AST1(node);
		result = const_fold(opn);
		break;
	case(as_qual_range):
		opn = N_AST1(node);
		op_type = N_TYPE(node);
		result = eval_qual_range(opn, op_type);
		if (is_const_constraint_error(result)) {
			create_raise(node, symbol_constraint_error);
			result = const_new(CONST_OM);
		}
		break;
	case(as_qual_index):
		eval_static(N_AST1(node));
		result = const_new(CONST_OM);
		break;
	case(as_attribute):
	case(as_range_attribute):
		/* use separate procedure for C */
		result = fold_attr(node);
		break;
	case(as_qualify):
		if (fold_context)
			result = const_fold(N_AST2(node));
		else
			/* in the context of a conformance check, keep qualification.*/
			result = const_new(CONST_OM);
		break;
		/* Type conversion:
		 * /TBSL/ These conversions are not properly checked!
		 */
	case(as_convert):
		/* use separate procedure for C */
		result = fold_convert(node);
		break;
	case(as_array_aggregate):
		/* This is treated in the expander.*/
		result = const_new(CONST_OM);
		break;
	case(as_record_aggregate):
		result = const_new(CONST_OM);
		break;
	case(as_selector): /*TBSL Case for discriminants needed */
		expn = N_AST1(node);
		eval_static(expn);
		return const_new(CONST_OM);
	case(as_slice):
		expn = N_AST1(node);
		discr_range = N_AST2(node);
		eval_static(expn);
		eval_static(discr_range);
		return const_new(CONST_OM);
	case(as_row):	/* Not folded for now.*/
		/* p1 := check_const_val(op1);
		 * if is_value(op1) then
		 *    result := ['array_ivalue', [op1(2)], 1, 1];
		 * else
		 */
		return const_new(CONST_OM);
	case(as_index):
		expn = N_AST1(node);
		index_list = N_AST2(node);
		eval_static(expn);

		FORTUP(index = (Node), N_LIST(index_list), ft1)
		    eval_static(index);
		ENDFORTUP(ft1);
		return const_new(CONST_OM);
	default:
		result = const_new(CONST_OM);
	}
	if (result->const_kind != CONST_OM)
		insert_and_prune(node, result);

	return result;
}