/*
 * Copyright (C) 1985-1992  New York University
 * 
 * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
 * warranty (none) and distribution info and also the GNU General Public
 * License for more details.

 */
#define GEN

#include "hdr.h"
#include "libhdr.h"
#include "vars.h"
#include "gvars.h"
#include "attr.h"
#include "slot.h"
#include "segment.h"
#include "set.h"
#include "lang.h"
#include "init.h"
#include "initobj.h"
#include "dbx.h"
#include "misc.h"
#include "util.h"
#include "glib.h"
#include "read.h"
#include "lib.h"
#include "arith.h"
#include "libr.h"
#include "gnodes.h"
#include "gmisc.h"
#include "gutil.h"
#include "aggr.h"
#include "chapp.h"
#include "smisc.h"
#include "gmain.h"
#include "expand.h"
//#include "glibp.h"

#ifdef MAC_GWADA
#include "ShellInterface.h"
#endif

void expand(Node node)												/*;expand*/
{
	/*
	 * Expander
	 * Performs a set of semantic transformations on the tree
	 * in order to simplify the job for the code generator.
	 * Some semantic optimizations are performed too.
	 * IMPORTANT: 
	 *    expand must not be called twice on the same structure, as
	 *    for some kinds of nodes, the format before expand is
	 *    different from the format after expand. A special problem
	 *    arises for aggregates, where already expanded structures
	 *    (subaggregates) are part of a not yet expanded structure
	 *    (assignment to enclosing structure) that must be expanded.
	 *    a special node, as_expanded, is used to block double
	 *    expansion in that case.
	 */

	Fortup      ft1, ft2;
	Tuple       tup, tup1, tup2;
	Symbolmap   instance_map = nil, type_map;	// explicit initialization added to avoid warning [Fabrizio Oddone]
	Node        node1, node2, node3, node4;
	Symbol      sym1, sym2, sym3, sym4;
	int         nk, cboolean;
	Const       lv;
	Unitdecl    ud;

	/* TBSL remove the following declarations */
	Const       lbd_1, ubd_1, lbd_2, ubd_2;
	int         ubd_1_val, ubd_2_val, lbd_1_val, lbd_2_val;

	Tuple  instantiation_code, ntup ;

#ifdef MAC_GWADA
	ProgressBar(1);
#endif

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

#ifdef DEBUG
	if (trapns>0 && N_SEQ(node)== trapns && N_UNIT(node) == trapnu) trapn(node);
#endif
	switch N_KIND(node) {

	case(as_insert):
		N_SIDE(node) = FALSE;
		FORTUP(node1 = (Node), N_LIST(node), ft1);
			expand(node1);
			N_SIDE(node) |= N_SIDE(node1);
		ENDFORTUP(ft1);
		node1 = N_AST1(node);
		expand(node1);
		N_SIDE(node) |= N_SIDE(node1);
		break;

	/* Chapter 3. Declarations and types*/
	/*
	 *-----------------
	 * 3.1 Declarations
	 */
	case(as_declarations):
		N_SIDE(node) = FALSE;
		if (N_LIST(node) == (Tuple)0)
			chaos(__FILE__, __LINE__, "expand.c: as_declarations N_LIST null");
		FORTUP(node1 = (Node), N_LIST(node), ft1);
			expand(node1);
			N_SIDE(node) |= N_SIDE(node1);
		ENDFORTUP(ft1);
		break;

	/*
	 *------------------------------
	 * 3.2 Objects and named numbers
	 */

	case(as_obj_decl):
	case(as_const_decl):
		expand_decl(node);
		break;

	/*
	 *-----------------------
	 * 3.3 Types and subtypes
	 * 3.3.1
	 */
	case(as_type_decl):
		expand_type(node);
		break;

	/* 3.3.2 */
	case(as_subtype_decl):
	expand_subtype(node);
		break;

	case(as_delayed_type):
		sym1 = N_UNQ(N_AST1(node)); /* type name */
		sym2 = N_UNQ(N_AST2(node)); /* parent name */
		node1 = copy_node(node);    /* delayed node */
		if (NATURE(sym1) == na_subtype)
			N_KIND(node1) = as_subtype_decl;
		else
			N_KIND(node1) = as_type_decl;
		nk = emap_get(sym2); 
		tup = EMAP_VALUE;
		if (!nk)  /* emap_defined */
			tup = tup_new1((char *) node1);
		else
			tup = tup_with(tup, (char *)node1);
		/* EMAP(sym2) = (EMAP(sym2)?[]) with node1;*/
		emap_put(sym2, (char *) tup);
		delete_node(node);
		break;

	case(as_subtype_indic):
		sym1 = N_UNQ(N_AST1(node)); /* type name */
		N_SIDE(node) = (unsigned)CONTAINS_TASK(sym1);
		node2 = N_AST2(node); /* expression */
		expand(node2);
		N_SIDE(node) |= N_SIDE(node2);
		break;
	/*
	 *-----------------
	 * 3.5 Scalar types
	 */
	case(as_digits):
		expand(N_AST1(node)); /* precision node */
		node2 = N_AST2(node); /* range node */
		expand(node2);
		N_SIDE(node) = N_SIDE(node2);
		break;

	case(as_delta):
		expand(N_AST1(node)); /* precision node */
		node2 = N_AST2(node); /* range node */
		expand(node2);
		N_SIDE(node) = N_SIDE(node2);
		break;

	case(as_subtype):
		node2 = N_AST2(node);
		expand(node2);
		N_SIDE(node) = N_SIDE(node2);

		/* Transmit tasks_declared: */
		sym1 = N_UNQ(N_AST1(node)); /* type name */
		/* N_TYPE(node) is parent type */
		CONTAINS_TASK(sym1) = CONTAINS_TASK(N_TYPE(node));
		break;

	case(as_component_list):
		node1 = N_AST1(node); /* invariant node */
		FORTUP(node2 = (Node), N_LIST(node1), ft1);
			expand(node2);     /* field node */
		ENDFORTUP(ft1);
		expand(N_AST2(node)); /* variant node */
		N_SIDE(node) = FALSE;
		break;

	case(as_simple_choice):
		node1 = N_AST1(node); /* expression */
		expand(node1);
		N_SIDE(node) = N_SIDE(node1);
		break;

	case(as_incomplete_decl):
		sym1 = N_UNQ(N_AST1(node)); /* type name */
		CONTAINS_TASK(sym1) = (char *) TRUE; /* May be. Future will tell */
		delete_node(node);
		break;

	/*
	 * Chapter 4. Names and expressions
	 *
	 *----------
	 * 4.1 Names
	 */
	case(as_range_choice):
		node1 = N_AST1(node);
		if (N_KIND(node1) == as_attribute) {
			/* must be range. */
			sym1 = N_TYPE(node1);
			nk = (int)attribute_kind(node1) - ATTR_RANGE;   /* 'T' or 'O'*/
			attribute_kind(node1) = (char *) (nk + ATTR_FIRST);
			N_AST2(node) = new_attribute_node(nk + ATTR_LAST,
			  N_AST2(node1), N_AST3(node1), sym1);
			N_KIND(node) = as_range;
			N_TYPE(node) = sym1;
			expand(node);
		}
		else {
			node2 = N_AST2(node1);
			expand(node2);
			N_SIDE(node) = N_SIDE(node2);
		}
		break;

	case(as_range):
		node1 = N_AST1(node); /* expression */
		node2 = N_AST2(node); /* expression */
		expand(node1);
		expand(node2);
		N_SIDE(node) = N_SIDE(node1) | N_SIDE(node2);
		break;

	case(as_constraint):
		N_SIDE(node) = FALSE;
		FORTUP(node1 = (Node), N_LIST(node), ft1);
			if (N_KIND(node1) == as_choice_list) {
				/* named discriminant constraints. Only need expression. */
				node1 = N_AST2(node1) ;
			}
			expand(node1);
			N_SIDE(node) |= N_SIDE(node1);
		ENDFORTUP(ft1);
		break;

	case(as_index):
		node1 = N_AST1(node) ; /* array node */
		expand(node1);
		N_SIDE(node) = N_SIDE(node1);
		/* N_AST2(node) is a list of indices */
		FORTUP(node2 = (Node), N_LIST(N_AST2(node)), ft1);
			expand(node2); /* index */
			N_SIDE(node) |=  N_SIDE(node2);
		ENDFORTUP(ft1);
		break;

	/*
	 * 4.1.2
	 */
	case(as_slice):
		node2 = N_AST2(node) ; /* range node */

		if (N_KIND(node2) == as_subtype) {
			/* remove subtype */
			node1 = N_AST2(node2); /* id node */
			copy_attributes(node1, node2);
		}

		if (is_simple_name(node2)) {
			/* type name replaced by range attribute */
			/* SETL has OPT_NODE as third arg in next call. This is
	 		 * wrong - want to indicate first dimension.
	 		 *  ds	9-8-85
	 		 */
			node2 = new_attribute_node(ATTR_T_RANGE, node2,
			  new_ivalue_node(int_const(1), symbol_integer), N_UNQ(node2));
			N_AST2(node) = node2 ;
		}
		node1 = N_AST1(node) ; /* array node */
		expand(node1);
		N_SIDE(node) = N_SIDE(node1);
		expand(node2);         /* range node */
		N_SIDE(node) |= N_SIDE(node2);
		break;

	case(as_field):
		node2 = N_AST2(node) ; /* expression */
		expand(node2);
		N_SIDE(node) = N_SIDE(node2);
		break;

	case(as_selector):
	case(as_all):
		node1 = N_AST1(node) ; /* expression */
		expand(node1);
		N_SIDE(node) = N_SIDE(node1);
		break;

	/*
	 * 4.1.4
	 */
	case(as_attribute):
	case(as_range_attribute):
		expand_attr(node);
		break;

	/*
	 *-------------
	 * 4.2 Literals
	 */
	case(as_string_ivalue):
		expand_string(node);
		break;

	case(as_int_literal):
		/* TBSL(JC) This is a kludge */
		N_KIND(node) = as_ivalue;
		lv = adaval(symbol_integer, N_VAL(node));
		if (adaval_overflow)
			chaos(__FILE__, __LINE__, "unable to convert integer literal");
		else
			N_VAL(node) = (char *) lv;
		N_SIDE(node) = FALSE;
		break;

	/*
	 *---------------
	 * 4.3 Aggregates
	 */
	case(as_array_aggregate):
#ifdef DEFER
		/* N_LIST assignmentnot needed in packed version  DS 3-86 */
		N_LIST(node) = (Tuple)0;    /* Useless information removed */
#endif
		expand_array_aggregate(node) ;
		N_SIDE(node) = N_KIND(node) != as_array_ivalue;
		/* TBSL better N_SIDE */
		break;

	case(as_row):
		node1 = N_AST1(node); /* expression */
		if (is_ivalue(node1) && root_type(N_TYPE(node1)) == symbol_character) {
			/* Transform into string litteral */
			/* Clear current AST_3 and AST_4 only if defined, thus preserving
	 		 * any N_UNQ and N_TYPE values if these are defined for the node.
	 		 */
			if (N_AST3_DEFINED(N_KIND(node))) N_AST3(node) = (Node) 0;
			if (N_AST4_DEFINED(N_KIND(node))) N_AST4(node) = (Node) 0;
			N_KIND(node) = as_string_ivalue;
			N_AST1(node) = (Node)0;
			N_AST2(node) = (Node)0;
			/* TBSL: check translation of following carefully */
			N_VAL(node) = (char *) tup_new1((char *) get_ivalue_int(node1));
		}
		else {
			/* Transform into an aggregate */
			N_KIND(node) = as_array_aggregate;
			/* positionnal */
			node3 = node_new(as_aggregate_list);
			node2         = node_new(as_list); /* positionnal */
			N_LIST(node2) = tup_new1((char *) node1);
			N_AST1(node3)  = node2 ;
			/* named */
			node2         = node_new(as_list); /* named */
			N_LIST(node2) = tup_new(0);
			N_AST2(node3)  = node2 ;
			N_AST1(node) = node3;

			N_AST2(node)  = OPT_NODE ;
			N_UNQ (node)  = new_unique_name("row");
		}
		expand(node);
		break;

	case(as_record_aggregate):
		expand_record_aggregate(node);
		N_SIDE(node) = N_KIND(node) != as_record_ivalue;
		/* TBSL better N_SIDE */
		break;

	/*
	 *----------------
	 * 4.4 Expressions
	 */

	/*
	 *----------------------------------------
 	* 4.5 Operators and expression evaluation
	 */
	case(as_op):
		expand_op(node);
		break;

	case(as_un_op):
		node2 = N_AST2(node) ; /* arguments */
		node1 = (Node) ((Tuple) N_LIST(node2)[1]);
		expand(node1);
		N_SIDE(node) = N_SIDE(node1);
		break;

	/*
	 *---------------------
	 * 4.6 Type conversions
	 */
	case(as_qual_range):
	case(as_qual_discr):
	case(as_qual_sub):
		node1 = N_AST1(node) ; /* expression */
		expand(node1);

		/* Note: must expand before checking types, as actual subtype of */
		/* aggregates may be determined by expansion. */
		sym1 = N_TYPE(node); /* qualification type */
		if (sym1 == get_type(node1) || is_unconstrained(sym1)) {
			/* remove qual */
			copy_attributes(node1, node);
		}
		else {
			N_SIDE(node) = N_SIDE(node1);
		}
		break;

	case(as_qual_index):
		node1 = N_AST1(node); /* expression */
		expand(node1);
		sym1 = N_TYPE(node); /* qualification type */
		sym2 = get_type(node1);
		if (sym1 == sym2 || is_unconstrained(sym1)) {
			/* remove qual */
			copy_attributes(node1, node);
		}
		else {
			/* tup_copy needed since index_types tuple used here
	 		 * destructiely  ds 6-25-85
	 		 */
			/* TBSL (JC) no copy needed. use FORTUPI */
			tup1 = tup_copy(index_types(sym1));
			tup2 = tup_copy(index_types(sym2));
			cboolean = TRUE;
			while (tup_size(tup1)) {
				sym3 = (Symbol) tup_fromb(tup1);
				sym4 = (Symbol) tup_fromb(tup2);
				node2 = (Node) ((Tuple) SIGNATURE(sym3)[2]); /* lower bound */
				node3 = (Node) ((Tuple) SIGNATURE(sym3)[3]); /* upper bound */
				lbd_1 = get_ivalue(node2);
				ubd_1 = get_ivalue(node3);
				node2 = (Node) ((Tuple) SIGNATURE(sym4)[2]); /* lower bound */
				node3 = (Node) ((Tuple) SIGNATURE(sym4)[3]); /* upper bound */
				lbd_2 = get_ivalue(node2);
				ubd_2 = get_ivalue(node3);
				if (N_KIND(node1) != as_slice && !is_unconstrained(sym2)
				  && lbd_1->const_kind != CONST_OM
				  && ubd_1->const_kind != CONST_OM
				  && lbd_2->const_kind != CONST_OM
				  && ubd_2->const_kind != CONST_OM) {
					lbd_1_val = INTV(lbd_1); 
					ubd_1_val = INTV(ubd_1);
					lbd_2_val = INTV(lbd_2); 
					ubd_2_val = INTV(ubd_2);
					if ((ubd_1_val - lbd_1_val) != (ubd_2_val - lbd_2_val)) {
						make_raise_node(node, symbol_constraint_error);
						USER_WARNING("Evaluation of expression will raise",
						  " CONSTRAINT_ERROR");
						cboolean = FALSE;
						break;
					}
					if ((ubd_1_val != ubd_2_val) || (lbd_1_val != lbd_2_val)) {
						cboolean = FALSE;
						break;
					}
				}
				else { /* non static */
					cboolean = FALSE;
					break;
				}
			} /* end loop */
			if (cboolean) {
				/* qual_index can be removed */
				copy_attributes(node1, node);
				N_TYPE(node) = sym1;
				if (is_aggregate(node))  {
					node2 = N_AST2(node); /* object node */
					TYPE_OF(N_UNQ(node2)) = sym1;
				}
				else if (N_KIND(node)==as_insert && is_aggregate(N_AST1(node))){
					node2 = N_AST2(N_AST1(node)); /* object node */
					TYPE_OF(N_UNQ(node2)) = sym1;
				}
			}
			else {
				N_SIDE(node) = N_SIDE(node1);
			}
		}
		break;

	case(as_qual_aindex):
	case(as_qual_alength):
	case(as_qual_adiscr):
		node1 = N_AST1(node) ; /* expression */
		expand(node1);
		if (N_KIND(node1) == as_null) {
			/* remove qual */
			copy_attributes(node1, node);
		}
		else {
			N_SIDE(node) = N_SIDE(node1);
		}
		break;

	case(as_convert):
		/* The target type of the conversion is the type of the node */
		/* The source type is the type of the expression itself. */
		node2 = N_AST2(node) ; /* expression */

		/* Special case: convert of a fixed point * or / */
		if (N_KIND(node2) == as_op && (op_kind(node2) == symbol_mulfx
		  || op_kind(node2) == symbol_divfx)) {

			/* Bind result type to the operation and remove node */
			N_TYPE(node2) = N_TYPE(node);
			copy_attributes(node2, node);
			expand(node);
		}
		else {
			expand(node2);
			N_SIDE(node) = N_SIDE(node2);

			/* Remove unnecessary conversion */
			if ((base_type(get_type(node2)) == base_type(N_TYPE(node))
			  && !is_unconstrained(base_type(N_TYPE(node))))
			  || ((root_type(get_type(node2)) == root_type(N_TYPE(node)))
			  && (is_discrete_type (root_type (get_type (node2)))))) {
				/*copy_attributes(node2, node); */
				N_KIND (node) = as_qual_range;
				N_AST1 (node) = N_AST2 (node);
			}
		}
		break;

	case(as_arg_convert):
		/*    The target type of the conversion is the type of the node
		 *    The source type is the type of the expression itself.
		 *    src_type    = get_type(node2) ;
		 *    target_type = N_TYPE(node);
		 */
		node2 = N_AST2(node) ; /* expression */
		expand(node2);
		N_SIDE(node) = N_SIDE(node2);
		break;

	/*
	 *---------------
	 * 4.8 Allocators
	 */
	case(as_new):
		node1 = N_AST1(node) ; /* id node */
		node2 = N_AST2(node) ; /* expression */
		sym1  = N_UNQ(node1) ; /* allocated type */
		/* N_TYPE(node) is the type of the context */
		sym2 = (Symbol) designated_type(N_TYPE(node)); /* accessed type */

		if (is_task_type(sym2)) {
			node2 = new_create_task_node(sym2);
			N_AST2(node) = node2 ;
		}
		else if ( is_access_type(sym2) && node2 == OPT_NODE) {
			node2 = node_new(as_null);
			N_AST2(node) = node2 ;
		}

		expand(node2);

		if (!is_simple_name(node1)) {
			/* There is a subtype to emit */
			expand(node1);
			make_insert_node(node, tup_new1((char *) node1), copy_node(node));
			node = N_AST1(node);
		}
		else if ( is_unconstrained(sym1)) {
			/* Establish proper subtype */
			if (is_array_type(sym1)) {
				/* Take constraint from initial value (always present in */
				/* this case) */
				sym1 = get_type(node2);
				N_UNQ(node1) = sym1;
			}
			else if (node2 == OPT_NODE) {  /* record */
				/* Create a subtype, constrained by default values. (Default
				 * values always present in that case). 
				 */
				sym1 = new_unique_name("constrained_type");
				N_UNQ(node1) = sym1;
				tup1 = constraint_new(co_discr);
				tup = tup_new(0);
				FORTUP(sym4 = (Symbol), discriminant_list_get(sym2), ft1);
					/* An allocator is always constrained. Set the constrained
					* bit accordingly
					*/
					if (sym4 == symbol_constrained)
						tup = discr_map_put(tup, sym4, 
					      new_ivalue_node(int_const(TRUE), symbol_boolean));
					else
						tup = discr_map_put(tup, sym4, 
					      copy_tree((Node) default_expr(sym4)));
				ENDFORTUP(ft1);
				tup1[2] = (char *) tup;
				new_symbol(sym1, na_subtype, sym2, tup1,
				  root_type(sym2));
				node1 = new_subtype_decl_node(sym1);
				expand(node1);
				make_insert_node(node,tup_new1((char *)node1), copy_node(node));
				node = N_AST1(node);
			}
			else if ( !is_unconstrained(get_type(node2))) {
				/* Use expression subtype for allocated object */
				sym3 = get_type(node2);
				N_UNQ(node1) = sym3;
			}
			else {
				/* Worst case: new REC'(F), where REC is unconstrained, and F
				 * returns REC. The subtype must be elaborated from the value
				 * of discriminants of the expression.
				 */
				sym3 = get_type(node2);
				sym1 = new_unique_name("constrained_type");
				N_UNQ(node1) = sym1;
				/* tup1 = [co_discr, {} ];*/
				tup1 = constraint_new(co_discr);
				tup1[2] = (char *) tup_new(0);
				new_symbol(sym1, na_subtype, sym2, tup1,
				  root_type(sym2));
				CONTAINS_TASK(sym1) = CONTAINS_TASK(sym2);

				node3         = node_new(as_type_and_value);
				N_AST1(node3) = new_name_node(sym1) ;
				N_AST2(node3) = node2 ;
				N_TYPE(node3) = sym3;
				N_AST1(node)  = node1 ;
				N_AST2(node)  = node3 ;
				if (N_AST3_DEFINED(N_KIND(node))) N_AST3(node) = (Node) 0;
				if (N_AST4_DEFINED(N_KIND(node))) N_AST4(node) = (Node) 0;
			}
		}
		sym3 = INIT_PROC(base_type(sym2));
		if (node2 == OPT_NODE && sym3 != (Symbol)0) {
			node2 = build_init_call(OPT_NODE, sym3, sym1, OPT_NODE);
			expand(node2);
			N_AST1(node) = node1 ;
			N_AST2(node) = node2;
			if (N_AST3_DEFINED(N_KIND(node))) N_AST3(node) = (Node) 0;
			if (N_AST4_DEFINED(N_KIND(node))) N_AST4(node) = (Node) 0;
		}
		N_SIDE(node) = TRUE;
		break;

		/** Chapter 5. Statements */

	case(as_null_s):
		break;

	case(as_line_no):
		ada_line     = (int) N_VAL(node);
		N_SIDE(node) = FALSE;
#ifdef TRACE
		if (debug_line>0 && ada_line >= debug_line) {
			expand_line();
		}
#endif
		break;
	
	/*
	 *-----------------------------------
	 * 5.1 Simple and compound statements
	 */
	case(as_statement):
		/* This node is used only for labelled statements, in front */
		/* of which labels are emitted. */
		expand(N_AST2(node)) ;
		break;

	case(as_statements):
		node1 = N_AST1(node) ; /* statements node */
		/* Note that if cboolean is true, the statement is not reachable 
		 * and therefore can be removed. TBSL: remove it from the list.
		 */
		cboolean = FALSE; /* first statement is always reachable */
		FORTUP(node2 = (Node), N_LIST(node1), ft1);
			if (N_KIND(node2) == as_statement)
				cboolean = FALSE;
			if (cboolean)
				delete_node(node2);
			else
				expand(node2);
			if (  N_KIND(node2) == as_raise 
		      || N_KIND(node2) == as_goto
		      || N_KIND(node2) == as_return 
		      || N_KIND(node2) == as_end
		      || N_KIND(node2) == as_terminate)
			cboolean = TRUE;
		ENDFORTUP(ft1);
		break;

	/*
	 *-------------------------
	 * 5.2 Assignment statement
 	*/
	case(as_assignment):
		expand(N_AST1(node)) ; /* variable node */
		expand(N_AST2(node)) ; /* expression */
		break;

	/*
	 *------------------
	 *  5.3 If statement
	 */
	case(as_if):
		node1 = N_AST1(node) ; /* if list node */
		node2 = N_AST2(node) ; /* else part */

		/* Remove branches guarded by static expressions */
		/* (conditional compilation) */
		tup = tup_new(0);
		FORTUP(node3 = (Node), N_LIST(node1), ft1);
			node4 = N_AST1(node3) ; /* condition */
			expand(node4);

			if (is_ivalue(node4)) {
				if (get_ivalue_int(node4) == TRUE) {
					/* This branch is guarded by TRUE: becomes the else part.
	      			 * All others branches are no longer reachable and
	       			 * may therefore be discarded.
	       			 */
					node2 = N_AST2(node3);
					break;
				}
				/* else FALSE: skip this node */
			}
			else {
				expand(N_AST2(node3));
				tup = tup_with(tup, (char *) node3);
			}
		ENDFORTUP(ft1);

		expand(node2); /* else part */

		if (tup_size(tup) == 0) {
			if (node2 == OPT_NODE)
				delete_node(node);
			else
				copy_attributes(node2, node);
		}
		else {
			N_LIST(node1) = tup;
			N_AST1(node)  = node1 ;
			N_AST2(node)  = node2 ;
		}
		break;

	/*
	 *--------------------
	 * 5.4 Case statements
	 */

	case(as_case):
	case(as_variant_decl):
		expand(N_AST1(node)) ; /* expression */
		tup1 = tup_copy(N_LIST(N_AST2(node))) ;
		/* tup_copy needed since tup1 used destructively
		 * in tup_fromb below  ds 6-25-85 
		 */
		if (tup_size(tup1) == 1) {
			/* Only one case... suppress case statement */
			node1 = (Node) tup_fromb(tup1); /* case branch */
			/* N_AST2(node1) is the list of statements for that branch */
			copy_attributes(N_AST2(node1), node);
			expand(node);
		}
		else {
			FORTUP(node1 = (Node), tup1, ft1);
				/* node1 is case node */
				node2 = N_AST1(node1) ; /* list of choices */
				expand(N_AST2(node1)) ; /* statements node */
				FORTUP(node1 = (Node), N_LIST(node2), ft2);
					/* in the inner loop node1 is choice node */
					nk = N_KIND(node1);
					if (nk == as_range_choice) {
						node3 = N_AST1(node1); /* id node */
						node4 = N_AST2(node3); /* range node */
						N_AST1(node1) = N_AST1(node4);
						N_AST2(node1) = N_AST2(node4);
						N_AST3(node1) = N_AST3(node4);
						N_AST4(node1) = N_AST4(node4);
						N_KIND(node1) = as_range;
					}
					else if (nk == as_simple_name) {
						sym1 = N_UNQ(node1); /* type name */
						tup = (Tuple) get_constraint(sym1);
						N_AST1(node1) = (Node) tup[2] ; /* lower bound */
						N_AST2(node1) = (Node) tup[3] ; /* upper bound */
						N_KIND(node1) = as_range;
					}
					else if (nk == as_simple_choice) {
						node3 = N_AST1(node1); /* lower bound */
						N_AST1(node1) = node3 ;
						N_AST2(node1) = node3 ;
						N_KIND(node1) = as_range;
					}
					else if (nk == as_others_choice || nk == as_range) {
						;
					}
					else {
						compiler_error_k(
						  "Unexpected choice in case statement: ", node1);
					}
				ENDFORTUP(ft2);
			ENDFORTUP(ft1);
		}
		break;

	/*
	 *--------------------
	 * 5.5 Loop statements
	 */

	case(as_loop):
		node1 = N_AST1(node) ; /* id node */
		node2 = N_AST2(node) ; /* iteration scheme */
		if (node2 != OPT_NODE) {
			expand(node2) ;
			if (N_KIND(node2) == as_insert) {
				propagate_insert(node2, node);
				node = N_AST1(node);
			}
		}
		nk = N_KIND(node2);
		if (nk == as_deleted)
			delete_node(node);
		else if (nk == as_raise)
			copy_attributes(node2, node);
		else { /* normal case */
			if (node1 != OPT_NODE) {
				sym1 = N_UNQ(node1); /* loop name */
				SIGNATURE(sym1) = (Tuple) FALSE;
			}
			expand(N_AST3(node)); /* statements */
			if (node1 != OPT_NODE) {
				/* Remove id node if not used */
				sym1 = N_UNQ(node1);
				if (is_generated_label(sym1) &&
				    SIGNATURE(sym1) == (Tuple) FALSE) {
					N_AST1(node) = OPT_NODE ;
				}
			}
		}
		break;

	case(as_while):
		expand(N_AST1(node)); /* condition node */
		break;

	case(as_for):
	case(as_forrev):
		expand_for(node);
		break;
	
	/*
	 *---------------------
	 * 5.6 Block statements
	 */

	case(as_block):
		node1 = N_AST1(node) ; /* id node */
		/* N_AST2(node) declaration node */
		/* N_AST3(node) statements node */
		/* N_AST4(node) handler node */
		if (is_simple_name(node1) && (N_UNQ(node1) == symbol_task_block)) {
			node2 = node_new(as_terminate); /* terminal node */
			tup = tup_new(2); 
			tup[1] = 0; 
			tup[2] = 0;
			N_VAL(node2) = (char *) tup;
		}
		else {
			node2 = node_new(as_end);       /* terminal node */
		}
		expand_block(N_AST2(node), N_AST3(node), N_AST4(node), node2);
		break;

	case(as_end):
		break;

	/*
	 *--------------------
	 * 5.7 Exit statements
	 */

	case(as_exit):
		expand(N_AST2(node)); /* condition node */
		sym1 = N_UNQ(node); /* loop name */
		SIGNATURE(sym1) = (Tuple) TRUE;
		break;

	/*
	 *----------------------
	 * 5.8 Return statements
	 */

	case(as_return):
		node1 = N_AST1(node) ; /* expression */
		if (node1 != OPT_NODE)
			expand(node1);
		break;

	/*
	 *--------------------
	 * 5.9 Goto statements
 	*/
	case(as_goto):
		break;

	/* Chapter 6. Subprograms */
	/*
	 *---------------------------
	 * 6.0 Predefined subprograms
	 */

	case(as_predef):
		sym1 = N_UNQ(node);     /* procedure name */
		sym2 = N_TYPE(node);    /* type name */
		tup = tup_new(2);
		tup[1] = (char *) N_VAL(node);
		/* integer mapped to the marker name */
		tup[2] = (char *) sym2;
		MISC(sym1) = (char *) tup;
		N_SIDE(node) = FALSE;
		break;

	case(as_interfaced):
		sym1 = N_UNQ(node);     /* procedure name */
		node1 = N_AST1(node);
		tup = tup_new(2);
		tup[1] = (char *) interface_counter++;  /* integer mapped to the
		                                               interfaced subprogram */
		/* the tuple interfaced_procedures consists of unit numbers of
		 * interfaced procedures followed by a string which contains
		 * the call to this interfaced procedure
		 */
		interfaced_procedures = tup_with(interfaced_procedures,
		  (char *) unit_number_now);
		if (streq(N_VAL(node1), "C")) {
			interfaced_procedures = tup_with(interfaced_procedures,
			  c_interface(sym1, (int) tup[1]));
		}
		else {
			interfaced_procedures = tup_with(interfaced_procedures,
			  fortran_interface(sym1, (int) tup[1]));
		}
		MISC(sym1) = (char *) tup;
		N_SIDE(node) = FALSE;
		break;

	/*
	 *----------------------
	 * 6.3 Subprogram bodies
	 */

	case(as_subprogram_tr):
		/* N_AST1(node) statements */
		/* N_AST2(node) declarations */
		/* N_AST4(node) handler */
		/* unique name of subprogram is now in the N_UNQ field of node. */
		sym1 = N_UNQ(node) ; /* subprogram name */

		if (NATURE(sym1) == na_procedure || NATURE(sym1) == na_procedure_spec) {
			/* Terminal node = return; */
			node2 = node_new(as_return);
			N_AST1(node2) = OPT_NODE ;
			N_AST2(node2) = new_name_node(sym1) ;
			N_AST3(node2) = new_number_node(0); /* depth */
		}
		else if (NATURE(sym1) == na_function
		  || NATURE(sym1) == na_function_spec) {
			/* Terminal node = raise PROGRAM_ERROR */
			node2 = new_raise_node(symbol_program_error);
		}
		else {     /* Task */
			node2 = node_new(as_terminate);
			tup = tup_new(2); 
			tup[1] = 0; 
			tup[2] = 0;
			N_VAL(node2) = (char *) tup;
		}

		/* The statement node is now in the N_AST1 field of node instead
		 * of N_AST3 field as it was when the node was as_subprogram
		 */
		expand_block(N_AST2(node), N_AST1(node), N_AST4(node), node2) ;
		N_SIDE(node) = TRUE;
		break;

	/*
	 *---------------------
	 * 6.4 Subprogram calls
	 */

	case(as_call):
	case(as_init_call):
		node1 = N_AST1(node) ; /* procedure id */
		node2 = N_AST2(node) ; /* list of arguments */
		sym1  = N_UNQ(node1) ; /* prcedure name */
		/* The following if statement is not in SETL source but was added
		 * to C version to fix renaming problem	ds 7-9-85
		 */
		if (ALIAS(sym1) != (Symbol)0) {
			sym1 = ALIAS(sym1);
			N_UNQ(node1) = sym1;
		}
		if (in_bin_ops(sym1)) {
			N_KIND(node) = as_op;
			expand(node);
		}
		else if (in_un_ops(sym1)) {
			N_KIND(node) = as_un_op;
			expand(node);
		}
		else {
			FORTUP(node1 = (Node), N_LIST(node2), ft1);
			expand(node1);
			ENDFORTUP(ft1);
			N_SIDE(node) = TRUE;
		}
		break;

	/*
	 * Chapter 7. Packages
	 *--------------------------------------------
	 * 7.2 Package specifications and declarations
	 */

	case(as_package_spec):
		/*Swap in symbol table private declarations with full declarations */
		sym1  = N_UNQ(N_AST1(node)) ; /* package name */
		private_install(sym1);

		node2 = N_AST2(node) ; /* declarations node */
		node3 = N_AST3(node) ; /* private declarations */
		expand(node2);
		expand(node3);

		N_SIDE(node) = N_SIDE(node2) | N_SIDE(node3);
		break;

	/*
	 *-------------------
	 * 7.3 Package bodies
	 */

	case(as_package_body):
		/* N_AST2(node) declarations */
		/* N_AST3(node) statements */
		/* N_AST4(node) handler */
		sym1 = N_UNQ(N_AST1(node)); /* package name */

		ud = unit_decl_get(unit_name);
		sym2 = ud->ud_unam; /* unit package */
		if (sym2 == sym1) { /* library unit */

			node4 = node_new(as_return);
			N_AST1(node4) = OPT_NODE;
			N_AST2(node4) = N_AST1(node);
			N_AST3(node4) = new_number_node(0); /* depth */
		}
		else {
			node4 = node_new(as_end);
		}

		if (N_AST3(node) == OPT_NODE) { /* statements */
			N_AST3(node) = new_statements_node(tup_new(0));
		}

		expand_block(N_AST2(node), N_AST3(node), N_AST4(node), node4);
		N_SIDE(node) = N_SIDE(N_AST2(node));
		break;

	/*
	 *----------------------------------------------------
	 * 7.4 Private type and deferred constant declarations
	 */

	case(as_use):
		delete_node(node);
		break;

	/*
	 * Chapter 8. Visibility rules
	 *--------------------------
	 * 8.5 Renaming declarations
	 */
	case(as_rename_obj):
		node1 = N_AST3(node) ; /* object node */
		expand(node1);
		N_SIDE(node) = N_SIDE(node1);
		break;

	case(as_rename_sub_tr):
		node2 = N_AST2(node) ; /* definition node */
		sym1  = N_UNQ(node) ; /* procedure name */
		tup1  = tup_copy(SIGNATURE(sym1));
		/* tup_copy needed since tup1 used in tup_fromb below */

		nk = N_KIND(node2);
		if (nk == as_attribute) {
			node2 = copy_node(node2); /* attribute node */
			sym3 = (Symbol) tup_fromb(tup1);
			N_AST2(node2) = new_name_node(TYPE_OF(sym3)) ;
			N_AST3(node2) = new_name_node(sym3) ;
			N_TYPE(node2) = TYPE_OF(sym1);
			node3 = node_new(as_return); /* return node */
			N_AST1(node3) = node2 ;
			N_AST2(node3) = new_name_node(sym1) ;
			N_AST3(node3) = new_number_node(0); /* depth */
			make_subprog_node(node, sym1, OPT_NODE,
			  new_statements_node(tup_new1((char *)node3)), OPT_NODE);
			expand(node);
		}
		else if (nk == as_entry_name) {
			node3 = node_new(as_ecall);       /* entry call */
			N_AST1(node3) = copy_node(node2); /* entry node */
			node2 = node_new(as_list);        /* arguments node */
			tup = tup_new(tup_size(tup1));
			FORTUPI(sym4 = (Symbol), tup1, nk, ft1);
				tup[nk] = (char *) new_name_node(sym4);
			ENDFORTUP(ft1);
			N_LIST(node2) = tup;
			N_AST2(node3) = node2;
			make_subprog_node(node, sym1, OPT_NODE,
			  new_statements_node(tup_new1((char *)node3)), OPT_NODE);
			expand(node);
		}
		else if (nk == as_simple_name) {
			/* handled fully by front-end. */
			delete_node(node);
		}
		else {
			compiler_error_k("Unknown kind in subprogram renaming: ", node2);
		}
		break;

	/*
	 * Chapter 9. Tasks
	 *----------------------------------------
	 * 9.1 Task specifications and task bodies
	 */

	case(as_task_spec):
		/* Separate declaration of the object from declaration of the type */
		sym1 = N_TYPE(node);   /* task type */
		sym2 = N_UNQ(node);    /* task name */
		node1 = copy_node(node); /* id node */
		N_KIND(node1) = as_task_type_spec;
		make_insert_node(node, tup_new1((char *) node1),
		  new_var_node(sym2, sym1, OPT_NODE));
		new_symbol(sym2, na_obj, sym1, (Tuple)0, (Symbol)0);
		expand(node);
		break;

	case(as_task_type_spec):
		/* Add the subprogram spec declaration in front
		 * and transform into type node.
		 */
		node2 = N_AST2(node); /* entries node */
		sym1 = N_TYPE(node); /* task type */
		sym2 = new_unique_name("task_init_proc"); /* associated procedure */
		assoc_symbol_put(sym1, TASK_INIT_PROC, sym2);
		CONTAINS_TASK(sym1) = (char *) TRUE;
		FORTUP(node1 = (Node), N_LIST(node2), ft1);
			expand(node1); /* entry node */
		ENDFORTUP(ft1);
		NATURE   (sym2) = na_task_body;
		TYPE_OF  (sym2) = symbol_none;
		SIGNATURE(sym2) = tup_new(0);
		generate_object(sym2); /* associated procedure */
		SIGNATURE(sym1) = N_LIST(node2);

		node2 = node_new(as_subprogram_decl_tr); /* subprogram node */
		N_UNQ(node2) = sym2;
		expand(node2);
		N_KIND(node) = as_type_decl;
		N_AST1(node) = new_name_node(sym1);
		N_AST2(node) = N_AST3(node) = (Node) 0;
		if (N_AST4_DEFINED(as_type_decl)) N_AST4(node) = (Node)0;
		N_SIDE(node) = FALSE;
		make_insert_node(node, tup_new1((char *)node2), copy_node(node));
		break;

	/*
	 *--------------------------------
	 * 9.2 Task types and task objects
	 */
	case(as_task):
		/* Transform it to procedure with modified statements */
		node1 = N_AST1(node); /* id node */
		/* N_AST2(node) declarations */
		/* N_AST3(node) statements */
		/* N_AST4(node) handler */
		/* N_UNQ(node1) task name */
		/* TYPE_OF(N_UNQ(node1)) type name */
		/* get associated procedure name */
		N_UNQ(node1) = assoc_symbol_get(TYPE_OF(N_UNQ(node1)), TASK_INIT_PROC);

		tup = tup_new(2);
		tup[1] = (char *) N_AST2(node); /* declaration node */
		node3 = node_new(as_end_activation);
		N_VAL(node3) = (char *) 1;      /* end activation OK */
		tup[2] = (char *) node3;
		N_KIND(node) = as_subprogram_tr;

		N_AST1(node) = new_statements_node(tup_new1((char *) new_block_node(
		  new_name_node(symbol_task_block), tup, tup_new1((char *)N_AST3(node)),
		  N_AST4(node))));
		N_AST2(node) = OPT_NODE;
		N_UNQ(node) = N_UNQ(node1);
		node2 = node_new(as_terminate); /* terminate node */
		tup = tup_new(2);
		tup[1] = (char *) 0;
		tup[2] = (char *) 2;
		N_VAL(node2) = (char *) tup;
		tup = tup_new(2);
		tup[2] = (char *) node2;        /* terminate node */
		node2 = node_new(as_end_activation);
		N_VAL(node2) = (char *) 0;   /* activation failed */
		tup[1] = (char *) node2;
		N_AST4(node) = new_statements_node( tup );
		expand(node);
		break;

	/*
	 *------------------------------------------------
	 * 9.3 Task Execution - Task Activation
	 */

	case(as_activate_spec):
		break;

	case(as_end_activation):
	case(as_create_task):
		N_SIDE(node) = TRUE;
		break;

	case(as_current_task):
		sym1 = N_UNQ(node); /* task name */
		N_SIDE(node) = FALSE;
#ifdef SHORT
		/* enable this code when and if support short integers */
		N_TYPE(node) = symbol_short_integer;
		new_symbol(sym1, na_obj, symbol_short_integer, (Tuple)0, (Symbol)0);
		make_const_node(node, sym1, symbol_short_integer, copy_node(node));
#else
		N_TYPE(node) = symbol_integer;
		new_symbol(sym1, na_obj, symbol_integer, (Tuple)0, (Symbol)0);
		make_const_node(node, sym1, symbol_integer, copy_node(node));
#endif
		break;

	case(as_entry_name):
		expand(N_AST1(node)); /*  task node */
		/* N_AST2(node)          entry node */
		node1 = N_AST3(node); /* index node */
		if (node1 != OPT_NODE) {
			node2 = copy_node(node1);
			/* Since N_AST3 and N_UNQ overlaid, clear N_AST3 field if 
			 * currently defined.
			 */
			if (N_AST3_DEFINED(N_KIND(node1)))
				N_AST3(node1) = (Node)0;
			N_KIND(node1) = as_convert;
#ifdef SHORT
			N_AST1(node1) = new_name_node(symbol_short_integer);
#else
			N_AST1(node1) = new_name_node(symbol_integer);
#endif
			N_LIST(node1) = (Tuple)0;
			N_AST2(node1) = node2 ;
#ifdef SHORT
			N_TYPE(node1) = symbol_short_integer;
#else
			N_TYPE(node1) = symbol_integer;
#endif
			expand(node1);
		}
		break;

	/*
	 *------------------------------------------------
	 * 9.4 Task Dependance - Termination of Tasks
	 */
	case(as_terminate):
		break;

	case(as_terminate_alt):
		break;

	/*
	 *------------------------------------------------
	 * 9.5 Entries, entry calls, and accept statements
	 */
	case(as_ecall):
		expand(N_AST1(node)) ; /* object node */
		node2 = N_AST2(node) ; /* arguments list */
		FORTUP(node1 = (Node), N_LIST(node2), ft1);
			expand(node1); /* argument node */
		ENDFORTUP(ft1);
		break;

	case(as_conditional_entry_call):
		/* Transform into timed entry call with delay 0 */
		/* N_AST1(node) call statement node */
		/* N_AST2(node) statements node */
		/* N_AST3(node) else part */
		node1 = node_new(as_delay_alt); /* delay alternative */
		node2 = node_new(as_delay);     /* delay expression  */
		N_AST1(node2) = new_ivalue_node(
		  rat_const(rat_fri(int_fri(0), int_fri(1))), symbol_duration);
		N_AST1(node1) = node2 ;
		N_AST2(node1) = N_AST3(node) ; /* else part */
		N_KIND(node) = as_timed_entry_call;
		N_AST3(node) = node1 ;
		expand(node);
		break;

	case(as_timed_entry_call):
		expand(N_AST1(node)) ; /* call node */
		expand(N_AST2(node)) ; /* stmt node */
		node1 = N_AST3(node) ; /* delay alternative */
		expand(N_AST1(node1)); /* delay expression  */
		expand(N_AST2(node1)); /* else part */
		break;

	case(as_accept):
		/* Replace [id_node, index_node] by an entry_name node */
		node1 = node_new(as_entry_name); /* entry name */
		N_AST1(node1) = OPT_NODE ;
		N_AST2(node1) = N_AST1(node); /* id node */
		N_AST3(node1) = N_AST2(node); /* index node */
		N_AST1(node) = node1 ;        /* entry name */
		N_AST2(node) = N_AST3(node);
		N_AST3(node) = node2 = N_AST4(node);
		N_AST4(node) = (Node) 0;
		expand(node1);

		if (node2 != OPT_NODE) {      /* body node */
			node1 = new_block_node(OPT_NODE, tup_new(0), 
			  tup_new1((char *)node2), node_new(as_exception_accept));
			expand(node1);
			N_AST3(node) = node1 ;
		}
		break;

	case(as_accept_alt):
		expand(N_AST1(node)); /* accept statement node */
		expand(N_AST2(node)); /* statements node */
		break;

	/*
	 *----------------------------------------
	 * 9.6 Delay statements, duration and time
	 */
	case(as_delay):
		expand(N_AST1(node)); /* expression */
		break;

	/*
	 *----------------------
	 * 9.7 Select statements
 	*/

	case(as_selective_wait):
		node1 = N_AST1(node); /* list of alternatives */
		FORTUP(node2 = (Node), N_LIST(node1), ft1);
			expand(node2);      /* alternative */
		ENDFORTUP(ft1);
		node2 = N_AST2(node); /* else part */
		if (node2 != OPT_NODE) {
			expand(node2); /* else part */
			node3 = node_new(as_delay_alt) ; /* delay alternative */
			N_AST2(node3) = node2 ;          /* else part */
			node2 = node_new(as_delay);
			N_AST1(node2) = new_ivalue_node(
			  rat_const(rat_fri(int_fri(0), int_fri(1))), symbol_duration);
			N_AST1(node3) = node2 ;          /* delay expression */
			N_LIST(node1) = tup_with(N_LIST(node1), (char *) node3);
		}
		break;

	case(as_guard):
		expand(N_AST1(node)); /* condition node */
		expand(N_AST2(node)); /* alternative node */
		break;

	case(as_delay_alt):
		expand(N_AST1(node)); /* expression */
		expand(N_AST2(node)); /* statements */
		break;

	/*
	 *---------------------
	 * 9.9 Abort statements
 	*/

	case(as_abort):
		FORTUP(node1 = (Node), N_LIST(node), ft1);
			expand(node1); /* id of the task to be aborted */
		ENDFORTUP(ft1);
		break;

	/*
	 * Chapter 10. Program structure and compilation issues
	 *---------------------------------------
	 * 10.1 Compilation units - Library units
	 */

	case(as_unit):
		expand(N_AST2(node)); /* unit root node */
		break;

	/*
	 *------------------------------------
	 * 10.2 Subunits of compilations units
	 */
	case(as_subprogram_stub_tr):
	case(as_package_stub):
	case(as_task_stub):
		lib_stub_put(N_VAL(node), AISFILENAME); /* N_VAL(node) is stub_name */
		stub_parent_put(N_VAL(node), unit_name);
		/* generate a slot for a fake proper body which is considered obsolete.
		 * This is due to handling of generic stubs.
		 */
		pUnits[unit_number(N_VAL(node))]->libInfo.obsolete = string_ds;/*"$D$"*/
		N_SIDE(node) = FALSE;
		break;

	case(as_separate):
		expand(N_AST2(node)); /* unit root node */
		break;

	/*
	 * Chapter 11. Exceptions
	 */
	/*
	 *------------------------
	 * 11.2 Exception handlers
	 */

	case(as_handler):
		/* Transform the handler into a "elsif test_exception or
		 * test_exception ... then statements".
		 * when others is expanded as an "elsif TRUE then statements"
		 * Do not expand statements, as they will be expanded when the if
		 * statement is.
		 */
		node1 = N_AST1(node) ; /* list of exceptions */
		tup  = N_LIST(node1) ; /* list of exception nodes */
		node1 = (Node) tup[1]; /* name of first exception */
		if (N_KIND(node1) == as_others)
			node2 = new_ivalue_node(int_const(TRUE), symbol_boolean);
		else {
			node2 = node_new(as_test_exception);     /* root of if */
			N_AST1(node2) = node1;      /* name of first exception */
			N_TYPE(node2) = symbol_boolean;
			for (nk = 2; nk <= tup_size(tup); nk++) {
				node1 = node_new(as_test_exception); /* running condition */
				N_AST1(node1) = (Node) tup[nk];      /* name of exception */
				N_TYPE(node1) = symbol_boolean;
				node2 = new_binop_node(symbol_or, node2, node1, symbol_boolean);
			}
		}

		node1 = N_AST2(node) ; /* statements */
		node3 = N_AST1(node1); /* list of statements */
		/* N_AST3(node) terminal statements node */
		N_LIST(node3) = tup_with(N_LIST(node3), (char *) N_AST3(node));

		N_KIND(node) = as_cond_statements;
		N_AST1(node) = node2 ; /* if list */
		N_AST3(node) = N_AST4(node) = (Node) 0;
		break;

	case(as_exception):
		/* Transform the handler into an if statement.
		 * Add an else part to that if: else raise.
		 * Note: if the user has provided a "when others" clause, this will
		 *       be expanded as an "elsif TRUE" branch, and optimization of
		 *       the if statement will remove the (now superfluous) else.
		 */
		node1 = N_AST1(node); /* terminal statement */
		FORTUP(node2 = (Node), N_LIST(node), ft1);
			N_AST3(node2) = copy_tree(node1);
			expand(node2); /* handler node */
		ENDFORTUP(ft1);

		tup = N_LIST(node);
		make_if_node(node, tup, new_raise_node(OPT_NAME));
		expand(node);   /* other transformations possible in this new form */
		break;

	/*
	 *-------------------------------------------------
	 * 11.5 Exceptions raised during task communication
	 */

	case(as_exception_accept):
		break;

	/*
	 * Chapter 12. Generics units
	 */
    case(as_generic_package):
      /*
       * Added here to traverse decls list to catch presence of stubs.
       * This is necessary to allocate a unit number for it to enable
       *  subsequent unit numbers to be correct.
       */
#ifdef TBSL
       expand(N_AST2(node));
#endif
       N_SIDE(node) = FALSE;
       break;
	/*
	 *---------------------------
	 * 12.3 Generic instanciation
	 */
	case(as_package_instance):
		/* This  node  indicates  a late  instantiation, i.e.  a  package
		 * instantiation  that  precedes  the  compilation of the generic
		 * package body. If the package has been seen, the instantiation is
		 * now completed. If none is needed, an empty package is created.
		 * Otherwise the missing body is treated as a stub.
		 */
		sym1 = N_UNQ(N_AST1(node)) ; /* package name */
		sym2 = N_UNQ(N_AST2(node)) ; /* generic name */
		retrieve_generic_body(sym2);
		tup = (Tuple) N_VAL(N_AST4(node));
		instance_map = (Symbolmap) tup[1];
		cboolean = (int) tup[2];
		tup = SIGNATURE(sym2);
		/* (Node) tup[2] declarations */
		/* (Node) tup[3] private part */
		node1 = (Node) tup[4];       /* body node */
		tup2 = (Tuple) tup[5]; 	   /* must_constrain generic types */

		/* check to see if this is a case where the body is a stub. */
		if (node1 == OPT_NODE) {
			char	 *stub_nam;
			tup = stubs(unit_name);
			FORTUP(stub_nam = (char *), tup, ft1);
				if (streq(unit_name_name(stub_nam), ORIG_NAME(sym2))) {
					if (!
#ifdef MAC_GWADA
		fab_read_ais
#else
		read_ais
#endif
					(AISFILENAME, TRUE, stub_nam, 0, TRUE)) break;
					tup  = SIGNATURE(sym2);
					node1 = (Node) tup[4];     /* body node */
					tup2 = (Tuple) tup[5];     /* must_constrain generic types*/
					break;
				}
			ENDFORTUP(ft1);
		}
		/*$TBSL retrieve_old_tree(node1); */
		retrieve_generic_tree(node1, (Node)0);
		if (node1 != OPT_NODE) {	   /* Instantiate body. */
			/* Instantiate all entities local to  the package body.
			 * Instance_map marks the entities defined in the spec, 
			 * and already instantiated.
			 */
			tup = instantiate_symbtab(sym2, sym1, instance_map);
			instance_map = (Symbolmap) tup[1];
			/* instantiate the AST itself, and complete the 
			 * instantiation of the symbol table.
			 */
			node_map = nodemap_new() ;		/* global object. */

			node2 = instantiate_tree(node1, instance_map) ; /* new body */
			N_KIND(node2) = as_package_body ;
			copy_attributes(node2, node);
			/* Node references in the symbol table 
			 * must point to the instantiated tree.
			 */
			tup1 = (Tuple) tup[3];
			update_symbtab_nodes(instance_map, tup1) ;
			tup1 = (Tuple) tup[2];
			check_priv_instance(tup2, instance_map) ;
			/* The full declarations of private entities must be updated as
			 * well, for the generic package and all inner packages.
			 */
			/*  loop for sym3 in tup1 do
			 *      private_decls(instance_map(sym3)) =
			 *	     update_private_decls(sym3, instance_map) ;
			 *  end loop ;
			 */
			FORTUP(sym3 = (Symbol), tup1, ft1);
				sym4 = symbolmap_get(instance_map, sym3);
				private_decls(sym4) =
				  (Set)update_private_decls(sym3, instance_map);
			ENDFORTUP(ft1);
			N_KIND(node) = as_package_body ;
			mint(node);
			expand(node) ;
		}
		else if ( ! cboolean) {
			/* assume that none will be seen, and build empty package body.*/
			N_KIND(node) = as_package_body ;
			N_AST1(node) = new_name_node(sym1) ;
			N_AST2(node) = OPT_NODE;
			N_AST3(node) = OPT_NODE;
			N_AST4(node) = OPT_NODE;
			expand(node) ;
		}
		else
			user_error("Separately compiled generics not supported ") ;
		break;

	case(as_function_instance):
	case(as_procedure_instance):
		/* Same as previous one, for subrograms. Here the body is always
		 * needed.
		 */
		/* Unpack instantiation information, attached to N_VAL of node. */
		tup = (Tuple)N_VAL(N_AST4(node));
		type_map = (Symbolmap)tup[1];
		sym1 = N_UNQ(N_AST2(node)) ; /* generic name */
		retrieve_generic_body(sym1);
		tup  = SIGNATURE(sym1);
		node1 = (Node) tup[3];       /* body node */
		tup1 = (Tuple) tup[4];	   /* must_constrain */

		/* check to see if this is a case where the body is a stub. */
		if (node1 == OPT_NODE) {
			char	 *stub_nam;
			tup = stubs(unit_name);
			FORTUP(stub_nam = (char *), tup, ft1);
				if (streq(unit_name_name(stub_nam), ORIG_NAME(sym1))) {
					if (!
#ifdef MAC_GWADA
		fab_read_ais
#else
		read_ais
#endif
					(AISFILENAME, TRUE, stub_nam, 0, TRUE)) break;
					tup = SIGNATURE(sym1);
					node1 = (Node) tup[3];       /* body node */
					tup1 = (Tuple) tup[4];	     /* must_constrain */
					break;
				}
			ENDFORTUP(ft1);
		}

		if (node1 != OPT_NODE) {
			/*$TBSL retrieve_old_tree(node1); */
			retrieve_generic_tree(node1, (Node)0);
			instantiation_code = N_LIST(N_AST3(node)) ;
			instantiate_subprog_tree(node, type_map) ;
			/* Take the subprogram created by the instantiation and reformat
			 * the spec node to be of a form as_procedure_tr (as_function_tr) 
			 * with the formal part detached from the tree. Move up the id_node
			 * (subprogram name) info to the specfication node.
			 */
			node2 = N_AST1(node);
			node3 = N_AST1(node2);
			N_KIND(node) = as_subprogram_tr;
			N_AST1(node) = N_AST3(node);
			N_UNQ(node) = N_UNQ(node3);
			/* add instantiation code to declarative part of subprogram.
	  		 * this is not strictly correct, as bounds checks should be
	  		 * elaborated outside of the subprogram body. To be cleaned up
	  		 * later.
	  		 */
			ntup = tup_add(instantiation_code, N_LIST(N_AST2(node))) ;
			tup_free(instantiation_code) ;
			N_LIST(N_AST2(node)) = ntup ;

			check_priv_instance(tup1, instance_map) ;
			mint(node);
			expand(node) ;
		}
		else
			user_error("Separately compiled generics not supported ") ;
		break;

	case(as_check_bounds):
		sym1 = N_UNQ(N_AST1(node)) ; /* generic type */
		sym2 = N_UNQ(N_AST2(node)) ; /* actual type */
		if (is_discrete_type (sym2)) {
			node1 = new_attribute_node(ATTR_T_FIRST, new_name_node(sym1),
			  OPT_NODE, sym1);
			node2 = new_attribute_node(ATTR_T_LAST, new_name_node(sym1),
			  OPT_NODE, sym1);
			node3 = new_attribute_node(ATTR_T_FIRST, new_name_node(sym2),
			  OPT_NODE, sym2);
			node4 = new_attribute_node(ATTR_T_LAST, new_name_node(sym2),
			  OPT_NODE, sym2);
			/*$ TBSL: some constant folding. */
			make_if_node(node,
			  tup_new1((char *) new_cond_stmts_node(
			  new_binop_node(symbol_or,
			  new_binop_node(symbol_ne,
			  node1,
			  node3,
			  symbol_boolean),
			  new_binop_node(symbol_ne,
			  node2,
			  node4,
			  symbol_boolean),
			  symbol_boolean),
			  new_raise_node(symbol_constraint_error)  )
			  ),
			  OPT_NODE);
		}
		else if (is_fixed_type (sym2)) {

			/* conversion of fixed is possible if they have the same accuracy */
			if (rat_neq ( RATV (get_ivalue
			  (((Node) numeric_constraint_delta (get_constraint(sym1))))),
			  RATV (get_ivalue
			  (((Node) numeric_constraint_delta (get_constraint(sym2))))))) {
				make_raise_node(node, symbol_constraint_error);
				USER_WARNING(
	"Due to difference in fixed point accuracy, conversion of array will raise",
				  " CONSTRAINT_ERROR"); 
			}
		}
		else if (is_float_type (sym2)) {

			/* conversion of float is possible if they have the same floating
			 * point accuracy
			 */
			if ( INTV (get_ivalue (((Node) numeric_constraint_delta
			  (get_constraint(sym1))))) != INTV (get_ivalue
			  (((Node) numeric_constraint_delta (get_constraint(sym2)))))) {
				make_raise_node(node, symbol_constraint_error);
				USER_WARNING(
"Due to difference in floating point accuracy, conversion of array will raise",
				  " CONSTRAINT_ERROR"); 
			}
		}
		expand(node);
		N_SIDE(node) = FALSE;
		break;

	case(as_check_discr):
		node1 = N_AST1(node) ;
		sym1  = N_UNQ(N_AST2(node)) ; /* type name */
		sym2  = N_UNQ(N_AST3(node)) ; /* dscriminant name */
		make_if_node(node,
		  tup_new1((char *) new_cond_stmts_node(
		  new_binop_node(symbol_ne,
		  node1,
		  new_discr_ref_node(sym2, sym1),
		  symbol_boolean),
		  new_raise_node(symbol_constraint_error)  )
		  ),
		  OPT_NODE);
		expand(node);
		N_SIDE(node) = FALSE;
		break;

	case(as_expanded):
		/* This node removed, WITHOUT expanding its descendant! */
		node1 = N_AST1(node); /* son node */
		copy_attributes(node1, node);
		break;

	/*
	 * Chapter 13. Representation clauses
	 *--------------------
	 * 13.2 Length clauses
	 */

	case(as_length_clause):
	case(as_enum_rep_clause):
	case(as_rec_rep_clause):
		delete_node(node);
		N_SIDE(node) = FALSE;
		break;

	case(as_opt):
		break;

	case(as_pragma):
	case(as_arg):
	case(as_enum):
	case(as_num_decl):
	case(as_int_type):
	case(as_float_type):
	case(as_fixed_type):
	case(as_array_type):
	case(as_record):
	case(as_discr_ref):
	case(as_simple_name):
	case(as_labels):
	case(as_ivalue):
	case(as_null):
	case(as_subprogram_decl_tr):
	case(as_private_decl):
	case(as_rename_ex):
	case(as_rename_pack):
	case(as_entry):
	case(as_entry_family):
	case(as_except_decl):
	case(as_raise):
	case(as_test_exception):
	case(as_generic_function):
	case(as_generic_procedure):
	case(as_generic_formals):
		N_SIDE(node) = FALSE;
		break;

	default:
		compiler_error_k( "Illegal kind of node in expand: ", node);
	}
}
