#include <sys/types.h>
#include <limits.h>
#include <stdio.h>
#include <string.h>
#include "ansi.h"
#include "host.h"
#include "files.h"
#include "hash.h"
#include "buffer.h"
#include "il.h"
#include "cpp.h"
#include "cpp_hide.h"
#include "cpp_eval.h"
#include "allocate.h"
#include "format.h"
#include "ada_name.h"
#include "vendor.h"
#include "host.h"
#include "units.h"
#include "cpp_hide.h"
#include "config.h"

/* This should be defined in limits.h */
#ifndef PATH_MAX
#define PATH_MAX	1024
#endif

extern int comment_size;
extern int repspec_flag;
extern int suppress_record_repspec;
extern int auto_package;
extern int flag_unions;
extern int import_decls;
extern int hex_flag;
extern int macro_functions;
extern int ada_version;

#undef NULL
#define NULL			0

#define MAX_INDENT(x)	{int _i = cur_indent(); if (_i > (x)) (x) = _i;}
#define HI_HALF(x)		(((x) >> 16) & 0xFFFF)
#define LO_HALF(x)		((x) & 0xFFFF)

static char order_warning[] = "Order of types MAY NOT be correct";

static macro_t *unknown_macro_list = NULL;

static int max_const_name_indent = 24;

typedef struct {
	symbol_t *qhead, *qtail;
} sym_q;

static struct {
	sym_q simple_ptr_typeq;
	sym_q simple_array_typeq;
	sym_q simple_typeq;
	sym_q rec_ptr_typeq;
	sym_q funcq;
	sym_q varq;

	/*
	 * The following queue will need to be sorted so
	 * that types get generated in an order appropriate
	 * for valid Ada semantics.
	 */
	sym_q sort_typeq;
}
compilation[MAX_UNIQ_FNAMES];

static macro_t *unit_macros[MAX_UNIQ_FNAMES];
static int macro_func_flag;

FILE *csource;

static void
enq(q, sym)
	sym_q *q;
	symbol_t *sym;
{
	assert(sym->sym_gen_list == NULL);

	if (q->qhead == NULL) {
		q->qhead = sym;
	}
	else {
		q->qtail->sym_gen_list = sym;
	}

	q->qtail = sym;
}

static decl_class_t
points_to(typ)
	typeinfo_t *typ;
{
	for (; decl_class(typ) == pointer_decl; typ = typ->type_next);
	return decl_class(typ);
}

void
gen_ada_type(sym)
	symbol_t *sym;
{
	typeinfo_t *typ;
	symbol_t *parent;
	int ord;

	assert(sym != NULL);
	assert(sym->sym_kind == type_symbol);

	typ = sym->sym_type;
	assert(typ != NULL);

	ord = (auto_package) ? FILE_ORD(sym->sym_def) : 0;

	switch (decl_class(typ)) {
	  case func_decl:
	  case pointer_decl:
		switch (points_to(typ->type_next)) {
		  case int_decl:
		  case fp_decl:
			enq(&compilation[ord].simple_ptr_typeq, sym);
			break;
		  case struct_decl:
			enq(&compilation[ord].rec_ptr_typeq, sym);
			break;
		  default:
			enq(&compilation[ord].sort_typeq, sym);
			break;
		}
		break;
	  case enum_decl:
	  case int_decl:
	  case fp_decl:
		enq(&compilation[ord].simple_typeq, sym);
		break;
	  case array_decl:
		typ = typ->type_next;
		assert(typ != NULL);

		switch (decl_class(typ)) {
		  case int_decl:
		  case fp_decl:
			enq(&compilation[ord].simple_array_typeq, sym);
			break;
		  default:
			enq(&compilation[ord].sort_typeq, sym);
			break;
		}
		break;
	  case struct_decl:
		enq(&compilation[ord].sort_typeq, sym);
		break;
	}
}

void
gen_ada_func(sym)
	symbol_t *sym;
{
	int ord;
	assert(sym != NULL);
	assert(sym->sym_kind == func_symbol);
	ord = (auto_package) ? FILE_ORD(sym->sym_def) : 0;
	enq(&compilation[ord].funcq, sym);
}

void
gen_ada_var(sym)
	symbol_t *sym;
{
	int ord;
	assert(sym != NULL);
	assert(sym->sym_kind == var_symbol);
	ord = (auto_package) ? FILE_ORD(sym->sym_def) : 0;
	enq(&compilation[ord].varq, sym);
}

static void
macro_enq(m)
	macro_t *m;
{
	macro_t *t, *last;
	int ord;

	assert(m != NULL);

	ord = FILE_ORD(m->macro_definition);

	assert(ord < MAX_UNIQ_FNAMES);

	for (last = NULL, t = unit_macros[ord]; t; t = t->macro_next) {
		last = t;
	}

	m->macro_next = NULL;
	if (last) {
		last->macro_next = m;
	}
	else {
		assert(unit_macros[ord] == NULL);
		unit_macros[ord] = m;
	}
}

static void
rethread_macros()
{
	macro_t *m, *next;

	assert(auto_package);

	for (m = macro_list_head; m; m = next) {
		next = m->macro_next;
		assert(next != m);
		m->macro_next = NULL;
		macro_enq(m);
	}
}

static int
keep_macro(m)
	macro_t *m;
{
	if (m->macro_body == NULL) return 0;
	if (m->macro_body_len < 1) return 0;
#if 0
	if (m->macro_params != -1) return 0;
#else
	if (m->macro_params < -1) return 0;
#endif
	if (! strcmp(m->macro_name, "NULL")) return 0;
	return 1;
}

static void
dump_macros(list, max)
	macro_t *list;
{
	macro_t *m;
	int i = 0;
	
	fprintf(stderr, "----------- macro dump --------\n");
	for (m = list; m; m = m->macro_next) {
		fprintf(stderr, "name <%s>, ada_name <%s>, body <%s>, ",
				m->macro_name, m->macro_ada_name, m->macro_body);
		fprintf(stderr, "body_len %d, params %d\n",
				m->macro_body_len, m->macro_params);
		if(i++ >= max)
			break;
	}
	fprintf(stderr, "----------- end macro dump --------\n");
}

static void
gen_macro_warnings()
{
	extern int macro_warnings;
	macro_t *m;
	
	if(macro_warnings) {
		for(m = unknown_macro_list; m; m = m->macro_next) {
			printf("%s untranslated, %s line %d\n",
				   m->macro_name,
				   file_name(m->macro_definition),
				   line_number(m->macro_definition));
		}
	}
	unknown_macro_list = NULL;
}

static int
could_be_ada_ident(s)
	register char *s;
{
	if(s == NULL) return 0;
	if (!strcmp(s, "NULL")) return 0;
	return 1;
#if 0
	while(is_alpha_numeric(*s++))
		;
	return is_alpha_numeric(s[-2]);
#endif
}

static void
add_unknown_macro(m)
	macro_t *m;
{
	char *s = m->macro_name;
	macro_t *p;
	
	if(m->macro_body == NULL) return;
	if(m->macro_params != 0) return;
	if(m->macro_definition == 0) return;

	m->macro_next = NULL;

	/* mjs@5/22/95
	 * The person who wrote this didn't take into account
	 * that if m already exists on the list we'll hose our
	 * list.
	 */
	for (p = macro_list_head; p; p = p->macro_next) {
		if (p == m) return;
	}

	if(m->macro_body != NULL && could_be_ada_ident(m->macro_name)) {
		m->macro_next = unknown_macro_list;
		unknown_macro_list = m;
	}
}

static void
gen_macro_names()
{
	macro_t *m, *next, *last;
	int ord;

	for (last = NULL, m = macro_list_head; m; m = next) {
		next = m->macro_next;
		if (auto_package) {
			/* Ada name is only unique within unit */
			ord = FILE_ORD(m->macro_definition);
		}
		else {
			ord = 0;
		}

		m->macro_ada_name = ada_name(m->macro_name, ord);

		if (keep_macro(m)) {
			last = m;
		}
		else {
			/* Pull macro out of list */
			if (last == NULL) {
				macro_list_head = next;
			}
			else {
				last->macro_next = next;
			}
			add_unknown_macro(m);
		}
	}
}

static void
mark_union(sym)
	symbol_t *sym;
{
	assert(sym != NULL);

	inform(cur_unit_path(), output_line(),
		   "Union %s generated from %s:%d",
		   sym->sym_ada_name,
		   file_name(sym->sym_def),
		   line_number(sym->sym_def));
}

enum num_base {_DEC,_HEX,_OCT};

static enum num_base
int_format(val,is_signed)
	host_int_t val;
	int is_signed;
{
	if (is_signed == 0 && val < 0) return _HEX;

	switch (val) {
	  case -1:					/* small ints in dec */
	  case 0:
	  case 1:
	  case 2:
	  case 3:
	  case 4:
	  case 5:
	  case 6:
	  case 7:
	  case 8:
	  case 9:
		return _DEC;
	  case 0x10:				/* Powers of 2 in hex */
	  case 0x20:
	  case 0x40:
	  case 0x80:
	  case 0x100:
	  case 0x200:
	  case 0x400:
	  case 0x800:
	  case 0x1000:
	  case 0x2000:
	  case 0x8000:
		return _HEX;
#if SIZEOF_INT >= 4
	  case 0x10000:
	  case 0x20000:
	  case 0x40000:
	  case 0x80000:
	  case 0x100000:
	  case 0x200000:
	  case 0x400000:
	  case 0x800000:
	  case 0x1000000:
	  case 0x2000000:
	  case 0x4000000:
	  case 0x8000000:
	  case 0x10000000:
	  case 0x20000000:
		return _HEX;
	  case 0x80000000:
		if (is_signed) return _DEC;
		return _HEX;
#endif
	  default:
		if (hex_flag) return _HEX;
		return _DEC;
	}
}

static void
print_value(val, is_signed, base)
	host_int_t val;
	int is_signed, base;
{
	char buf[64];

	switch (base) {
	  case 16: goto in_hex;
	  case 8: goto in_octal;
	}

	switch (int_format(val, is_signed)) {
	  case _HEX:
	  in_hex:
		if (sizeof(val) > 2 && (val < 0 || val > 0x8000)) {
			if (sizeof(val) == 4) {
				sprintf(buf, "16#%04X_%04X#", HI_HALF(val), LO_HALF(val));
			} else {
				sprintf(buf, "16#%X#", val);
			}
		} else {
			sprintf(buf, "16#%04X#", val);
		}
		break;
	  case _DEC:
		sprintf(buf, "%d", val);
		break;
	  case _OCT:
	  in_octal:
		sprintf(buf, "8#%04o#", val);
		break;
	}
	put_string(buf);
}

static void
print_fp_value(val)
	host_float_t val;
{
	char buf[128];

	sprintf(buf, "%.20e", val);
	put_string(buf);
}

static void
cond_concat(count, in_quote)
	int *count, *in_quote;
{
	if (in_quote[0] == 0 && count[0] != 0) {
		put_string("&");
		count[0]++;
	}
}

static void
cond_start_quote(count, in_quote)
	int *count, *in_quote;
{
	if (!in_quote[0]) {
		put_char('"');
		in_quote[0] = 1;
		count[0]++;
	}
}

static void
cond_end_quote(count, in_quote)
	int *count, *in_quote;
{
	if (in_quote[0]) {
		put_char('"');
		in_quote[0] = 0;
		count[0]++;
	}
}

static void
print_ascii(c, count)
	int c, *count;
{
	char buf[128];

	switch (c) {
	  case '\n':
		put_string("ascii.lf");
		count[0] += 8;
		break;
	  default:
		sprintf(buf, "character'val(%d)", c);
		put_string(buf);
		count[0] += strlen(buf);
		break;
	}
}

static int
is_printable(c)
	unsigned int c;
{
	if (is_alpha_numeric(c)) return 1;
	if (c >= ' ' && c <= '/') return 1;
	if (c >= ':' && c <= '`') return 1;
	return c >= '{' && c <= '~';
}

static void
print_string_value(val)
	char *val;
{
	int warned = 0;
	int in_quote = 0;
	int last_count = 0;
	int count;
	int strpos;
	unsigned int c;

	strpos = cur_indent();

	for (count = 0; *val; val++) {
		c = (unsigned int) *val;
		if (c > 127) {
			if (! warned) {
				warned = 1;
				warning(cur_unit_path(), output_line(),
						"Extended character set not yet supported");
			}
		}
		else if (is_printable(c)) {
			cond_concat(&count, &in_quote);
			cond_start_quote(&count, &in_quote);
			put_char((int)c);
			count++;
		}
		else {
			cond_end_quote(&count, &in_quote);
			if (count - last_count > 14) {
				last_count = count;
				new_line();
				indent_to(strpos);
			}
			cond_concat(&count, &in_quote);
			print_ascii(c, &count);
		}
	}

	cond_end_quote(&count, &in_quote);

    if (ada_compiler != GNAT) {
		cond_concat(&count, &in_quote);
		put_string("ascii.nul");
	}
}

static void
comment_start()
{
	indent_to(ADA_COMMENT_COLUMN);
	put_string("-- ");
}

static void
comment_sizeof(size, align)
	unsigned int size, align;
{
	char buf[80];
	comment_start();
	sprintf(buf, "sizeof(%d) alignof(%d)\n", size, align);
	put_string(buf);
}

static void
print_position(pos)
	file_pos_t pos;
{
	char buf[64];
	comment_start();
	put_string(file_name(pos));
	sprintf(buf, ":%d\n", line_number(pos));
	put_string(buf);
}

static int
valid_comment(n)
	node_t *n;
{
	return n != NULL && n->node_kind == _Ident && n->node.id.cmnt != NULL;
}

static void
c_comment(n)
	node_t *n;
{
	char *p;

	if (!valid_comment(n)) return;

	p = n->node.id.cmnt;

	while (is_white(*p)) {
		p++;
	}

	if (*p == 0) return;

	for (;;) {
		comment_start();
	  again:
		switch (*p) {
		  case 0:
			new_line();
			return;
		  case '\n':
			new_line();
			p++;
			while (is_white(*p)) {
				p++;
			}
			if (*p == 0) return;
			break;
		  default:
			put_char(*p);
			p++;
			goto again;
		}
	}
}

static void
do_macro_comment(p, i, last)
	char *p;
	int i, last;
{
	comment_start();
	for (; i < last; i++) {
		if (!is_white(p[i])) break;
	}

	for (; i < last; i++) {
		switch (p[i]) {
		  case '*':
			if (p[i+1] == '/') {
				new_line();
				return;
			}
			put_char(p[i]);
			break;
		  case '\n':
			new_line();
			comment_start();
			for (i++; i < last; i++) {
				if (!is_white(p[i])) {
					i--;
					break;
				}
			}
			break;
		  default:
			put_char(p[i]);
			break;
		}
	}
	new_line();
}

static void
macro_comment_and_position(m)
	macro_t *m;
{
	extern int translate_comments;
	char *p;
	int i;

	if (translate_comments) {
		p = m->macro_body;

		assert(p != NULL);

		for (i = 0; i < m->macro_body_len - 1; i++) {
			if (p[i] == '/' && p[i+1] == '*') {
				do_macro_comment(p, i+2, m->macro_body_len);
				break;
			}
		}
	}

	print_position(m->macro_definition);
}

static void
c_comment_or_position(sym)
	symbol_t *sym;
{
	if (valid_comment(sym->sym_ident)) {
		c_comment(sym->sym_ident);
	}
	else {
		print_position(sym->sym_def);
	}
}

static void
gen_const_int(name, val, pos, base)
	char *name;
	host_int_t val;
	file_pos_t pos;
	int base;
{
	indent_to(ADA_TAB_STOP);
	put_string(name);
	MAX_INDENT(max_const_name_indent);
	indent_to(max_const_name_indent);
	put_string(": constant := ");
	print_value(val,1,base);
	put_char(';');
}

static void
gen_const_float(name, val)
	char *name;
	host_float_t val;
{
	indent_to(ADA_TAB_STOP);
	put_string(name);
	MAX_INDENT(max_const_name_indent);
	indent_to(max_const_name_indent);
	put_string(": constant := ");
	print_fp_value(val);
	put_char(';');
}

static void
gen_const_string(name, val, pos)
	char *name, *val;
	file_pos_t pos;
{
	indent_to(ADA_TAB_STOP);
	put_string(name);
	MAX_INDENT(max_const_name_indent);
	indent_to(max_const_name_indent);
	put_string(": constant string := ");
	print_string_value(val);
	put_char(';');
	print_position(pos);
}

static void
gen_const_rename(name, unit, pos, typ)
	char *name, *typ;
	int unit;
	file_pos_t pos;
{
	char *p;

	indent_to(ADA_TAB_STOP);
	put_string(name);
	MAX_INDENT(max_const_name_indent);
	indent_to(max_const_name_indent);
	put_string(": constant");
	put_string(typ);
	put_string(" := ");

	p = unit_name(unit);
	assert(p != NULL);

	put_string(p);
	put_char('.');
	put_string(name);
	put_char(';');

	if (strlen(typ)) print_position(pos);
}

static cpp_eval_result_t
eval_macro_func(m)
	macro_t *m;
{
	int i;
	cpp_eval_result_t result;
	char text[1024];

	assert(m->macro_params >= 0);
	assert(m->macro_body != NULL);
	assert(m->macro_body_len > 0);
	assert(m->macro_ada_name != NULL);

	sprintf(text, "%s(", m->macro_name);

	for (i = 0; i < m->macro_params; i++) {
		if (i != 0) strcat(text,",");
		strcat(text,"1");
	}

	strcat(text, ")");

	return cpp_eval(text);
}

static void
change_ext(p, ext)
	char *p, *ext;
{
	char *last = p;
	for (; *p; p++) {
		switch (*p) {
		  case '/':
			last = p;
			break;
		  case '.':
			if (*last != '.') last = p;
			break;
		}
	}

	strcpy(last, ext);
}

static void
gen_c_func(m)
	macro_t *m;
{
	int i;

	if (macro_func_flag == 0) {
		char fname[PATH_MAX];
		char *unit_path;
		int uord;

		macro_func_flag = 1;

		strcpy(fname, cur_unit_path());
		change_ext(fname, ".c");

		csource = fopen(fname, "w");
		if (csource == NULL) {
			perror(fname);
			exit(1);
		}

		inform(NULL,0, "Generating %s", fname);

		for (i = 0; ; i++) {
			uord = nth_direct_ref_unit_ord(i);
			if (uord == -1) break;
			fprintf(csource, "#include \"%s\"\n", include_path(uord));
		}
		fprintf(csource, "#include \"%s\"\n", cur_unit_source());
	}

	fprintf(csource, "\n/* %s:%d */\n", 
			file_name(m->macro_definition),
			line_number(m->macro_definition));

	fprintf(csource, "int\n%s%s(", MACRO_FUNC_PREFIX, m->macro_name);

	for (i = 0; i < m->macro_params; i++) {
		if (i != 0) fputc(',', csource);
		fprintf(csource, "p%d", i+1);
	}

	fputs(")\n", csource);

	for (i = 0; i < m->macro_params; i++) {
		fprintf(csource, "\tint p%d;\n", i+1);
	}

	fputs("{\n\treturn (", csource);

	fprintf(csource, "%s(", m->macro_name);
	for (i = 0; i < m->macro_params; i++) {
		if (i != 0) fputc(',', csource);
		fprintf(csource, "p%d", i+1);
	}

	fputs("));\n}\n", csource);
}

static void
gen_mfunc(m, import)
	macro_t *m;
	int import;
{
	int i, pstart;
	char param[16];
	cpp_eval_result_t result;

	result = eval_macro_func(m);

	if (EVAL_FAILED(result)) return;

	if (import == -1) {
		gen_c_func(m);
	}

	new_line();
	indent_to(ADA_TAB_STOP);
	put_string("--@@ Created from C macro");

	new_line();
	indent_to(ADA_TAB_STOP);

	put_string("function ");
	put_string(m->macro_ada_name);

	if (m->macro_params > 0) {
		put_char('(');
		pstart = cur_indent();
		for (i = 0; i < m->macro_params; i++) {
			if (i != 0) put_char(',');
			sprintf(param, "p%d", i+1);
			put_string(param);
		}
		put_string(": ");
		put_string(TYPE_NAMEOF_SIGNED_INT);
		put_char(')');
		new_line();
		indent_to(pstart);
		put_string("return ");
	}
	else {
		pstart = cur_indent() + 1;
		put_string(" return ");
	}


	if (IS_EVAL_INT(result)) {
		put_string(TYPE_NAMEOF_SIGNED_INT);
	} else if (IS_EVAL_FLOAT(result)) {
		put_string(TYPE_NAMEOF_DOUBLE);
	} else {
		put_string(TYPE_NAMEOF_CHAR_POINTER);
	}

	if (import != -1) {
		new_line();
		indent_to(pstart);
		put_string("renames ");
		put_string(unit_name(import));
		put_char('.');
		put_string(m->macro_ada_name);
	}

	put_char(';');
	macro_comment_and_position(m);
}

static void
gen_mconst(m, import)
	macro_t *m;
	int import;
{
	cpp_eval_result_t result;

	assert(m->macro_params == -1);
	assert(m->macro_body != NULL);
	assert(m->macro_body_len > 0);
	assert(m->macro_ada_name != NULL);

	result = cpp_eval(m->macro_body);

	if (EVAL_FAILED(result)) {
        /*
         * make a try at finding ones like
         *    #define x (int) 123
         * and
         *    #define x ((int) 123)
         */
        {
            char *leftparen, *rightparen, *rightparen2, c;

            leftparen = strrchr(m->macro_body, '(');
            rightparen = strchr(m->macro_body, ')');
            if(leftparen && rightparen && (leftparen < rightparen)) {
                rightparen2 = strrchr(m->macro_body, ')');
                if(rightparen2) {
                    c = *rightparen2;
                    *rightparen2 = '\0';
                }
                result = cpp_eval(&rightparen[1]);
                if(rightparen2)
                    *rightparen2 = c;
                if (IS_EVAL_INT(result)) {
                    indent_to(4);
                    put_string(m->macro_ada_name);
                    MAX_INDENT(max_const_name_indent);
                    indent_to(max_const_name_indent);
                    put_string(": constant ");
                    c = *rightparen;
                    *rightparen = '\0';
                    put_string(&leftparen[1]);
                    *rightparen = c;
                    put_string(" := ");
                    print_value(EVAL_INT(result),
                            result.base);
                    put_char(';');
                    print_position(m->macro_definition);
                    return;
                }
            }
        }
        add_unknown_macro(m);
        return;
    }

	if (IS_EVAL_INT(result)) {
		if (import == -1) {
			gen_const_int(m->macro_ada_name, EVAL_INT(result),
						  m->macro_definition, result.base);
			macro_comment_and_position(m);
		}
		else {
			gen_const_rename(m->macro_ada_name, import, m->macro_definition, "");
			macro_comment_and_position(m);
		}
		return;
	}
	if (IS_EVAL_FLOAT(result)) {
		if (import == -1) {
			gen_const_float(m->macro_ada_name, EVAL_FLOAT(result));
			macro_comment_and_position(m);
		}
		else {
			gen_const_rename(m->macro_ada_name, import, m->macro_definition, "");
			macro_comment_and_position(m);
		}
		return;
	}
	if (IS_EVAL_STRING(result)) {
		if (import == -1) {
			gen_const_string(m->macro_ada_name, EVAL_STRING(result), m->macro_definition);
		}
		else {
			gen_const_rename(m->macro_ada_name, import, m->macro_definition, " string");
		}
		return;
	}
    add_unknown_macro(m);
}

static void
gen_macro_constants(m, import)
	macro_t *m;
	int import;
{
	macro_t *next;
	for (; m; m = next) {
		next = m->macro_next;
		if (m->macro_params == -1)
			gen_mconst(m, import);
	}
}

static void
gen_macro_functions(m, import)
	macro_t *m;
	int import;
{
	macro_t *next;
	for (; m; m = next) {
		next = m->macro_next;
		if (m->macro_params >= 0)
			gen_mfunc(m, import);
	}
}

static int
from_header_file()
{
	char *p;

	for (p = cur_unit_source(); *p; p++) {
		if (p[0] == '.' && p[1] == 'h' && p[2] == 0) {
			return 1;
		}
	}

	return 0;
}

static int
should_import()
{
	if (!auto_package || !import_decls) {
		return 0;
	}
	return from_header_file();
}

static void
import_macro_functions()
{
	macro_t *m;
	char *p;
	int i;
	int uord;

	if (!should_import()) return;

	for (i = 0; ; i++) {
		uord = nth_direct_ref_unit_ord(i);
		if (uord == -1) break;
		gen_macro_functions(unit_macros[uord], uord);
	}
}

static void
gen_interface_mfunc(m)
	macro_t *m;
{
	int i;
	char param[16];
	cpp_eval_result_t result;

	result = eval_macro_func(m);

	if (EVAL_FAILED(result)) return;

	new_line();
	indent_to(ADA_TAB_STOP);
	put_string("--@@ Created from C macro");

	new_line();
	indent_to(ADA_TAB_STOP);

	put_string("pragma interface(C, ");
	put_string(m->macro_ada_name);
	put_string(");");
	print_position(m->macro_definition);

	switch (ada_compiler) {
	  case VADS:
		indent_to(ADA_TAB_STOP);
		put_string("pragma interface_name(");
		put_string(m->macro_ada_name);
		put_string(", language.c_subp_prefix & \"");
		put_string(MACRO_FUNC_PREFIX);
		put_string(m->macro_name);
		put_string("\");\n");
		break;
	  default:
		indent_to(ADA_TAB_STOP);
		put_string("pragma interface_name(");
		put_string(m->macro_ada_name);
		put_string(", \"");
		put_string(C_SUBP_PREFIX);
		put_string(MACRO_FUNC_PREFIX);
		put_string(m->macro_name);
		put_string("\");\n");
		break;
	}
}

static void
interface_macro_functions(m, import)
	macro_t *m;
	int import;
{
	macro_t *next;
	for (; m; m = next) {
		next = m->macro_next;
		if (m->macro_params >= 0)
			gen_interface_mfunc(m);
	}

	if (macro_func_flag) {
		fclose(csource);
		csource = NULL;
	}
}

static void
import_macro_constants()
{
	macro_t *m;
	char *p;
	int i;
	int uord;

	if (!should_import()) return;

	for (i = 0; ; i++) {
		uord = nth_direct_ref_unit_ord(i);
		if (uord == -1) break;
		gen_macro_constants(unit_macros[uord], uord);
	}
}

static int
num_elements(typ)
	typeinfo_t *typ;
{
	assert(typ != NULL);
	assert(typ->type_kind == array_of);
	return typ->type_info.array_elements;
}

static int
upper_array_bound(typ)
	typeinfo_t *typ;
{
	int elem;
	assert(typ != NULL);
	assert(typ->type_kind == array_of);
	elem = num_elements(typ);
	return (elem < 0) ? 0 : elem - 1;
}

static void
concat_dimensions(buf, typ)
	typeinfo_t *typ;
	char *buf;
{
	symbol_t *basetype;
	int upper_bound;
	char tmp[32];

	for (; is_array(typ); typ = typ->type_next) {
		basetype = typ->type_base;
		assert(basetype != NULL);

		if (! basetype->sym_type->_typedef) {
			strcat(buf, "(0..");

			upper_bound = upper_array_bound(typ);

			if (upper_bound == 0 && num_elements(typ) == -1) {
				if (is_array(typ->type_next)) {
					strcpy(tmp, "0)");
				} else {
					strcpy(tmp, "c.max_bound)");
				}
			} else {
				sprintf(tmp, "%d)", upper_bound);
			}

			strcat(buf, tmp);
		}
	}
}

static int
can_use_basetype(typ)
	typeinfo_t *typ;
{
	symbol_t *basetype = typ->type_base;
	int result;

	assert(basetype != NULL);

	typ->type_base = NULL;
	result = equal_types(typ, basetype->sym_type);
	typ->type_base = basetype;

	return result;
}

static char*
type_nameof(typ, use_parent_type)
	typeinfo_t *typ;
	int use_parent_type;
{
	static char buf[1024];

	symbol_t *basetype;
	int size;
	int unsgnd;
	int unit_ord;

	assert(typ != NULL);

	basetype = typ->type_base;
	if (basetype != NULL && can_use_basetype(typ)) {
		if (use_parent_type && decl_class(typ) == struct_decl) {
			assert(basetype->sym_type != NULL);
			basetype = basetype->sym_type->type_base;
			assert(basetype != NULL);
		}
		assert(basetype->sym_ada_name != NULL);

		unit_ord = FILE_ORD(basetype->sym_def);
		if ((!auto_package) || unit_ord == current_unit() || basetype->intrinsic) {
			strcpy(buf, basetype->sym_ada_name);
		} else {
			sprintf(buf, "%s.%s", unit_name(unit_ord), basetype->sym_ada_name);
		}

		if (is_array(typ)) concat_dimensions(buf, typ);
		return buf;
	}

	switch (decl_class(typ)) {
	  case int_decl:
		unsgnd = typ->_unsigned;
		size = typ->_sizeof;

		if (size == SIZEOF_CHAR)	return unsgnd ? TYPE_NAMEOF_UNSIGNED_CHAR 	: TYPE_NAMEOF_SIGNED_CHAR;
		if (size == SIZEOF_SHORT)	return unsgnd ? TYPE_NAMEOF_UNSIGNED_SHORT 	: TYPE_NAMEOF_SIGNED_SHORT;
		if (size == SIZEOF_INT)		return unsgnd ? TYPE_NAMEOF_UNSIGNED_INT 	: TYPE_NAMEOF_SIGNED_INT;
		if (size == SIZEOF_LONG)	return unsgnd ? TYPE_NAMEOF_UNSIGNED_LONG 	: TYPE_NAMEOF_SIGNED_LONG;
#ifdef SIZEOF_LONG_LONG
		if (size == SIZEOF_LONG_LONG) return unsgnd ? TYPE_NAMEOF_UNSIGNED_LONG_LONG : TYPE_NAMEOF_SIGNED_LONG_LONG;
#endif
		break;
	  case field_decl:
		sprintf(buf, "c.bits%d", typ->_sizeof);
		return buf;
	  case fp_decl:
#ifdef SIZEOF_LONG_DOUBLE
		if (typ->_long && size == SIZEOF_LONG_DOUBLE) {
			return TYPE_NAMEOF_LONG_DOUBLE;
		}
#endif
		break;
	  case enum_decl:
	  case pointer_decl:
	  case func_decl:
	  case array_decl:
	  case struct_decl:
		break;
	  default:
		assert(0);
		break;
	}

	basetype = typ->type_base;
	if (basetype != NULL) {
		assert(basetype->sym_ada_name != NULL);

		unit_ord = FILE_ORD(basetype->sym_def);
		if ((!auto_package) || unit_ord == current_unit() || basetype->intrinsic) {
			return basetype->sym_ada_name;
		}
		sprintf(buf, "%s.%s", unit_name(unit_ord), basetype->sym_ada_name);
		if (is_array(typ)) concat_dimensions(buf, typ);
		return buf;
	}

	return " <botched type name> ";
}
	

static int
derived_in_same_unit(sym, typ)
	symbol_t *sym;
	typeinfo_t *typ;
{
	symbol_t *basetype;
	int result;

	if (sym->intrinsic) return 0;
	basetype = typ->type_base;
	if (basetype == NULL) return 0;
	if (FILE_ORD(sym->sym_def) != FILE_ORD(basetype->sym_def)) return 0;
	typ->type_base = NULL;
	result = equal_types(typ, basetype->sym_type);
	typ->type_base = basetype;
	return result;
}

static void
gen_int_type(sym)
	symbol_t *sym;
{
	typeinfo_t *typ;
	symbol_t *basetype;

	assert(sym != NULL);
	assert(sym->sym_type != NULL);

	typ = sym->sym_type;

	indent_to(ADA_TAB_STOP);
	put_string("type ");
	put_string(sym->sym_ada_name);
	put_string(" is new ");

	if (derived_in_same_unit(sym, typ)) {
		do {
			assert(typ->type_base != NULL);
			assert(typ->type_base->sym_type != NULL);
			basetype = typ->type_base;
			typ = basetype->sym_type;
		} while (derived_in_same_unit(basetype, typ));

		put_string(type_nameof(typ, 0));
	}
	else {
		put_string(type_nameof(typ, 0));
	}
	put_char(';');
	c_comment(sym->sym_ident);
	print_position(sym->sym_def);

	if (comment_size) {
		comment_sizeof(typ->_sizeof, typ->_alignof);
	}
}

static void
gen_fp_type(sym)
	symbol_t *sym;
{
	gen_int_type(sym);			/* Same logic for ints and floats */
}

static void
gen_size_rep(sym)
	symbol_t *sym;
{
	typeinfo_t *typ;
	char buf[32];

	assert(sym != NULL);

	typ = sym->sym_type;
	assert(typ != NULL);

	indent_to(ADA_TAB_STOP);
	put_string("for ");
	put_string(sym->sym_ada_name);
	put_string("'size use ");
	sprintf(buf, "%d;", typ->_sizeof * BITS_PER_BYTE);
	put_string(buf);
	print_position(sym->sym_def);
}

static int
default_enum_cardinality(tag)
	symbol_t *tag;
{
	int ord = 0;

	for (; tag; tag = tag->sym_parse_list) {
		if (tag->sym_value.intval != ord++) {
			return 0;
		}
	}

	return 1;
}

static void
gen_enum_type(sym)
	symbol_t *sym;
{
	extern int enum_reps;
	symbol_t *tag;
	char buf[64];

	indent_to(ADA_TAB_STOP);
	put_string("type ");
	put_string(sym->sym_ada_name);
	put_string(" is (");
	c_comment(sym->sym_ident);
	print_position(sym->sym_def);

	for (tag = sym->sym_tags; tag; tag = tag->sym_parse_list) {
		indent_to(ADA_TAB_STOP * 2);
		put_string(tag->sym_ada_name);
		if (tag->sym_parse_list != NULL) {
			put_char(',');
		}
		c_comment_or_position(tag);
	}

	indent_to(ADA_TAB_STOP);
	put_string(");\n");

	if (enum_reps != 0 || !default_enum_cardinality(sym->sym_tags)) {
		indent_to(ADA_TAB_STOP);
		put_string("for ");
		put_string(sym->sym_ada_name);
		put_string(" use (");
		print_position(sym->sym_def);

		for (tag = sym->sym_tags; tag; tag = tag->sym_parse_list) {
			indent_to(ADA_TAB_STOP * 2);
			put_string(tag->sym_ada_name);
			sprintf(buf, " => %d", tag->sym_value.intval);
			put_string(buf);
			if (tag->sym_parse_list != NULL) {
				put_char(',');
			}
			print_position(tag->sym_def);
		}

		indent_to(ADA_TAB_STOP);
		put_string(");\n");
	}

	gen_size_rep(sym);
}

static void
gen_enum_subtype(sym)
	symbol_t *sym;
{
	symbol_t *basetype;

	assert(sym != NULL);
	assert(sym->sym_type != NULL);

	basetype = sym->sym_type->type_base;

	assert(basetype != NULL);

	indent_to(ADA_TAB_STOP);
	put_string("subtype ");
	put_string(sym->sym_ada_name);
	put_string(" is ");
	put_string(basetype->sym_ada_name);
	put_char(';');
	c_comment(sym->sym_ident);
	print_position(sym->sym_def);
}

static void
gen_var_or_field(sym, tabpos, colonpos, import)
	symbol_t *sym;
	int tabpos, colonpos;
	int import;
{
	typeinfo_t *typ;

	assert(sym != NULL);
	assert(sym->sym_ada_name != NULL);
	assert(sym->sym_type != NULL);

	typ = sym->sym_type;

	indent_to(tabpos);
	put_string(sym->sym_ada_name);

	if (colonpos != 0) {
		indent_to(colonpos);
	}

	put_string(": ");
	put_string(type_nameof(typ, 0));

	if (import != -1) {
		put_string(" renames ");
		put_string(unit_name(import));
		put_char('.');
		put_string(sym->sym_ada_name);
	}

	put_char(';');
	c_comment_or_position(sym);

	if (comment_size) {
		comment_sizeof(typ->_sizeof, typ->_alignof);
	}
}

static void
check_unknown_type_macros(name)
	char *name;
{
	macro_t *m, *last, *next;
	
	for (last = NULL, m = unknown_macro_list; m; m = next) {
		next = m->macro_next;
		assert(next != m);
		if(!strcmp(name, m->macro_body)) {
			indent_to(4);
			put_string("subtype ");
			put_string(m->macro_name);
			put_string(" is ");
			put_string(name);
			put_string(";");
			print_position(m->macro_definition);
			if(last != NULL) {
				last->macro_next = next;
			} else {
				unknown_macro_list = next;
			}
		} else {
			last = m;
		}
	}
}

static void
gen_simple_types(typeq)
	sym_q *typeq;
{
	symbol_t *sym;
	typeinfo_t *typ;

	if (typeq->qhead != NULL) {
		new_line();
	}

	for (sym = typeq->qhead; sym; sym = sym->sym_gen_list) {
		typ = sym->sym_type;
		switch(decl_class(typ)) {
		  case int_decl:
			gen_int_type(sym);
			break;
		  case enum_decl:
			if (typ->type_base == sym) {
				new_line();
				gen_enum_type(sym);
			}
			else {
				gen_enum_subtype(sym);
			}
			break;
		  case fp_decl:
			gen_fp_type(sym);
			break;
		}
        check_unknown_type_macros(sym->sym_ada_name);
	}
}


static void
import_subtype(typeq)
	sym_q *typeq;
{
	symbol_t *sym;
	int unit;

	for (sym = typeq->qhead; sym; sym = sym->sym_gen_list) {
		unit = FILE_ORD(sym->sym_def);

		indent_to(ADA_TAB_STOP);
		put_string("subtype ");
		put_string(sym->sym_ada_name);
		put_string(" is ");
		put_string(unit_name(unit));
		put_char('.');
		put_string(sym->sym_ada_name);
		put_char(';');
		c_comment(sym->sym_ident);
		print_position(sym->sym_def);
	}
}

static int
any_type_decls(uord)
	int uord;
{
	return compilation[uord].simple_typeq.qhead != NULL
		|| compilation[uord].simple_ptr_typeq.qhead != NULL
		|| compilation[uord].simple_array_typeq.qhead != NULL
		|| compilation[uord].rec_ptr_typeq.qhead != NULL
		|| compilation[uord].sort_typeq.qhead != NULL;
}

static void
import_types()
{
	int uord;
	int i;

	if (!should_import()) return;

	new_line();

	for (i = 0; ; i++) {
		uord = nth_direct_ref_unit_ord(i);
		if (uord == -1) break;
		if (any_type_decls(uord)) {
			new_line();
			indent_to(ADA_TAB_STOP);
			put_string("-- imported subtypes from ");
			put_string(unit_name(uord));
			new_line();

			import_subtype(&compilation[uord].simple_typeq);
			import_subtype(&compilation[uord].simple_ptr_typeq);
			import_subtype(&compilation[uord].simple_array_typeq);
			import_subtype(&compilation[uord].rec_ptr_typeq);
			import_subtype(&compilation[uord].sort_typeq);
		}
	}
}

static symbol_t*
change_access_type(sym)
	symbol_t *sym;
{
	typeinfo_t *typ = sym->sym_type;
	symbol_t *basetype;

	if (!is_access_to_record(typ)) return NULL;

	typ = typ->type_next;
	basetype = typ->type_base;

	if (basetype != basetype->sym_type->type_base) {
		return basetype->sym_type->type_base;
	}

	return NULL;
}

static int
multiple_params(params)
	symbol_t *params;
{
	return params != NULL && params->sym_parse_list != NULL;
}

static int gen_params();

static void
gen_function_pointer(sym, typ)
    symbol_t *sym;
    typeinfo_t *typ;
{
    int indent;
    typeinfo_t *func;

    if(ada_version >= 95) {
        put_string("type ");
        put_string(sym->sym_ada_name);
        put_string(" is access ");
        func = typ->type_next;
        if (func->type_next->type_kind == void_type) {
            put_string("procedure ");
            indent = gen_params(sym->sym_tags);
        } else {
            put_string("function ");
            indent = gen_params(sym->sym_tags);
            if (multiple_params(sym->sym_tags)) {
                new_line();
                indent_to(indent);
            }
            put_string(" return ");
            put_string(type_nameof(func->type_next));
        }
    } else {
        put_string("subtype ");
        put_string(sym->sym_ada_name);
		put_string(TYPE_NAMEOF_FUNCTION_POINTER);
    }
}

static void
gen_access_t(sym)
	symbol_t *sym;
{
	typeinfo_t *typ;
	symbol_t *basetype;

	assert(sym != NULL);

	typ = sym->sym_type;

	assert(typ != NULL);
	assert(typ->type_kind == pointer_to);
	assert(typ->type_next != NULL);

	indent_to(ADA_TAB_STOP);

	if (is_function_pointer(typ)) {
		gen_function_pointer(sym, typ);
	}
	else if (basetype = change_access_type(sym)) {
		put_string("type ");
		put_string(sym->sym_ada_name);
		put_string(" is access ");
        if(ada_version >= 95) {
            if (typ->type_next->_constant) {
                put_string("constant ");
            }
            else {
                put_string("all ");
            }
        }
		put_string(type_nameof(basetype->sym_type, 1));
	}
	else {
		put_string("type ");
		put_string(sym->sym_ada_name);
		put_string(" is access ");
        if(ada_version >= 95) {
            if (typ->type_next->_constant) {
                put_string("constant ");
            }
            else {
                put_string("all ");
            }
        }
 		put_string(type_nameof(typ->type_next, 1));
	}

	put_char(';');
	c_comment(sym->sym_ident);
	print_position(sym->sym_def);

	if (comment_size) {
		comment_sizeof(typ->_sizeof, typ->_alignof);
	}
}

static void
gen_access_types(typeq)
	sym_q *typeq;
{
	symbol_t *sym;

	if (typeq->qhead != NULL) {
		new_line();
	}

	for (sym = typeq->qhead; sym; sym = sym->sym_gen_list) {
		gen_access_t(sym);
        check_unknown_type_macros(sym->sym_ada_name);
	}
}

static void
gen_record_incompletes(typeq)
	sym_q *typeq;
{
	symbol_t *sym;
	typeinfo_t *typ;

	if (typeq->qhead != NULL) {
		new_line();
	}

	for (sym = typeq->qhead; sym; sym = sym->sym_gen_list) {
		typ = sym->sym_type;
		assert(typ != NULL);

		if (decl_class(typ) == struct_decl) {
			if (typ->type_base != NULL && typ->type_base != sym) {
				;
			}
			else {
				indent_to(ADA_TAB_STOP);
				put_string("type ");
				put_string(sym->sym_ada_name);
				put_char(';');
				print_position(sym->sym_def);

				if (comment_size) {
					comment_sizeof(typ->_sizeof, typ->_alignof);
				}
			}
		}
	}
}

static int
q_max_lhs_name_len(q)
	sym_q *q;
{
	symbol_t *sym;
	int max = 0;
	int len;

	for (sym = q->qhead; sym; sym = sym->sym_gen_list) {
		assert(sym->sym_ada_name != NULL);
		len = strlen(sym->sym_ada_name);
		if (len > max) max = len;
	}

	return max;
}

static int
max_lhs_name_len(sym)
	symbol_t *sym;
{
	int max, len;

	for (max = 0; sym; sym = sym->sym_parse_list) {
		assert(sym->sym_ada_name != NULL);
		len = strlen(sym->sym_ada_name);
		if (len > max) max = len;
	}

	return max;
}

static int
has_bitfields(tags)
	symbol_t *tags;
{
	typeinfo_t *typ;

	assert(tags != NULL);

	for (; tags; tags = tags->sym_parse_list) {
		typ = tags->sym_type;
		if (typ->type_kind == field_type) {
			return 1;
		}
	}

	return 0;
}

static int
bit_sizeof(typ)
	typeinfo_t *typ;
{
	assert(typ != NULL);
	return (typ->type_kind == field_type) ? typ->_sizeof
		: typ->_sizeof * BITS_PER_BYTE;
}

static void
gen_record_rep(sym, largest_lhs)
	symbol_t *sym;
	int largest_lhs;
{
	symbol_t *tag;
	typeinfo_t *typ;
	int is_union;

	if (suppress_record_repspec) {
		return;
	}

	assert(sym != NULL);

	typ = sym->sym_type;	assert(typ != NULL);
	tag = sym->sym_tags;	assert(tag != NULL);

	is_union = typ->type_kind == union_of;

	if (repspec_flag || is_union || has_bitfields(sym->sym_tags)) {
		new_line();

		if (flag_unions && is_union) {
			mark_union(sym);
		}

		indent_to(ADA_TAB_STOP);
		put_string("for ");
		put_string(sym->sym_ada_name);
		put_string(" use");
		print_position(sym->sym_def);
		indent_to(ADA_TAB_STOP * 2);
		put_string("record at mod ");
		print_value(typ->_alignof,1,10);
		put_string(";\n");

		for (; tag; tag = tag->sym_parse_list) {
			typ = tag->sym_type;
			assert(typ != NULL);

			indent_to(ADA_TAB_STOP * 3);
			put_string(tag->sym_ada_name);
			indent_to(largest_lhs + ADA_TAB_STOP * 3);
			put_string(" at 0 range ");
			print_value(tag->bitoffset,1,10);
			put_string(" .. ");
			print_value(tag->bitoffset + bit_sizeof(typ) - 1, 1, 10);
			put_char(';');
			print_position(tag->sym_def);
		}

		indent_to(ADA_TAB_STOP * 2);
		put_string("end record;\n");
	}
    else if (ada_version >= 95) {
        new_line();
        indent_to(4);
        put_string("pragma Convention(C,  ");
        put_string(sym->sym_ada_name);
        put_string(");");
        print_position(sym->sym_def);
    }
}

static void
gen_record_t(sym)
	symbol_t *sym;
{
	symbol_t *tag, *biggest_tag;
	int biggest_tag_size;
	typeinfo_t *typ;
	int largest_lhs;
	int has_comment;
    int is_gnat_union;

	assert(sym != NULL);

	typ = sym->sym_type;
	assert(typ != NULL);

    is_gnat_union = (ada_compiler == GNAT) &&
            (typ->type_kind == union_of);

	new_line();

	has_comment = valid_comment(sym->sym_ident);

	if (typ->type_base != NULL && typ->type_base != sym) {
		indent_to(ADA_TAB_STOP);
		put_string("subtype ");
		put_string(sym->sym_ada_name);
		put_string(" is ");
		put_string(typ->type_base->sym_ada_name);
		put_char(';');
		c_comment(sym->sym_ident);
		print_position(sym->sym_def);
		if (has_comment) new_line();
	}
	else {
		indent_to(ADA_TAB_STOP);

        if (is_gnat_union) {
            tag = sym->sym_tags;
            if (tag != NULL) {
            put_string("type ");
            put_string(sym->sym_ada_name);
            put_string("_kind is (");
            if (has_comment) {
                c_comment(sym->sym_ident);
            }
            else {
                print_position(sym->sym_def);
            }
            for (; tag; tag = tag->sym_parse_list) {
                indent_to(ADA_TAB_STOP*2);
                put_string(tag->sym_ada_name);
                put_string("_kind");
                if(tag->sym_parse_list != NULL)
                put_string(",");
                new_line();
            }
            indent_to(ADA_TAB_STOP);
            put_string(");");
            new_line();
            new_line();
            indent_to(ADA_TAB_STOP);
            }
        }

		put_string("type ");
		put_string(sym->sym_ada_name);
        if (is_gnat_union) {
            put_string(" (Which: ");
            put_string(sym->sym_ada_name);
            put_string("_kind");
            biggest_tag = NULL;
            biggest_tag_size = 0;
            for(tag = sym->sym_tags; tag; tag = tag->sym_parse_list) {
            if(biggest_tag_size < tag->sym_type->_sizeof) {
                biggest_tag_size = tag->sym_type->_sizeof;
                biggest_tag = tag;
            }
            }
            if(biggest_tag != NULL) {
            put_string(" := ");
            put_string(biggest_tag->sym_ada_name);
            put_string("_kind");
            }
            put_string(")");
        }
		put_string(" is");
		if (has_comment) {
			c_comment(sym->sym_ident);
		}
		else {
			print_position(sym->sym_def);
		}

		indent_to(ADA_TAB_STOP * 2);
		put_string("record");
		if (has_comment) {
			print_position(sym->sym_def);
		}
		else if (comment_size) {
			comment_sizeof(typ->_sizeof, typ->_alignof);
		}
		else {
			new_line();
		}

		tag = sym->sym_tags;

		if (tag == NULL) {
			indent_to(ADA_TAB_STOP * 3);
			put_string("null;\n");
			indent_to(ADA_TAB_STOP * 2);
			put_string("end record;\n");
		}
		else {
			largest_lhs = max_lhs_name_len(tag);

            if(is_gnat_union) {
                indent_to(12);
                put_string("case Which is");
                new_line();
                for (; tag; tag = tag->sym_parse_list) {
                indent_to(16);
                put_string("when ");
                put_string(tag->sym_ada_name);
                put_string("_kind =>");
                new_line();
                gen_var_or_field(tag, 20, largest_lhs + 12, -1);
                }
                indent_to(12);
                put_string("end case;");
                new_line();
                indent_to(8);
                put_string("end record;");
                new_line();
                new_line();
                indent_to(4);
                put_string("pragma Convention(C, ");
                put_string(sym->sym_ada_name);
                put_string(");");
                new_line();
                indent_to(4);
                put_string("pragma Unchecked_Union(");
                put_string(sym->sym_ada_name);
                put_string(");");
            } else {
				for (; tag; tag = tag->sym_parse_list) {
					gen_var_or_field(tag, 12, largest_lhs + 12, -1);
				}

				indent_to(ADA_TAB_STOP * 2);
				put_string("end record;");
			}

			if (has_comment && comment_size) {
				comment_sizeof(typ->_sizeof, typ->_alignof);
			}
			else {
				new_line();
			}

            if(!is_gnat_union) {
				gen_record_rep(sym, largest_lhs);
			}
		}
	}
}

static void
gen_array_t(sym)
	symbol_t *sym;
{
	symbol_t *tag;
	typeinfo_t *typ;
	char buf[64];
	int has_comment;
	int upper_bound;

	assert(sym != NULL);

	typ = sym->sym_type;
	assert(typ != NULL);

	has_comment = valid_comment(sym->sym_ident);

	new_line();
	indent_to(ADA_TAB_STOP);
	put_string("type ");
	put_string(sym->sym_ada_name);
	put_string(" is");
	print_position(sym->sym_def);
	indent_to(ADA_TAB_STOP * 2);

	if (typ->_typedef) {
		put_string("array(integer range 0..");

		upper_bound = upper_array_bound(typ);

		if (upper_bound == 0 && num_elements(typ) == -1) {
			if (is_array(typ->type_next)) {
				strcpy(buf, "0)");
			} else {
				strcpy(buf, "c.max_bound)");
			}
		} else {
			sprintf(buf, "%d)", upper_bound);
		}
		put_string(buf);
	}
	else {
		put_string("array(integer range <>)");
	}

	if (has_comment) {
	}
	if (comment_size) {
		comment_sizeof(typ->_sizeof, typ->_alignof);
	}
	else {
		new_line();
	}
	indent_to(ADA_TAB_STOP * 2);
	put_string("of ");
	put_string(type_nameof(typ->type_next, 0));
	put_char(';');
	if (has_comment) {
		c_comment(sym->sym_ident);
	}
	else {
		new_line();
	}
}

static void
gen_array_types(typeq)
	sym_q *typeq;
{
	symbol_t *sym;

	for (sym = typeq->qhead; sym; sym = sym->sym_gen_list) {
		gen_array_t(sym);
        check_unknown_type_macros(sym->sym_ada_name);
 	}
}

static void
gen_sorted_types(typeq)
	sym_q *typeq;
{
	symbol_t *sym;
	typeinfo_t *typ;
	decl_class_t prev = struct_decl;
	decl_class_t cur;

	for (sym = typeq->qhead; sym; sym = sym->sym_gen_list) {
		typ = sym->sym_type;
		assert(typ != NULL);

		cur = decl_class(typ);

		switch (cur) {
		  case func_decl:
		  case pointer_decl:
			cur = pointer_decl;
			if (prev != cur) {
				new_line();
			}
			gen_access_t(sym);
			break;
		  case array_decl:
			gen_array_t(sym);
			break;
		  case struct_decl:
			gen_record_t(sym);
			break;
		  default:
			assert(0);
			break;
		}

		prev = cur;
        check_unknown_type_macros(sym->sym_ada_name);
	}
}

static int
single_void(param)
	symbol_t *param;
{
	typeinfo_t *typ;

	if (param->sym_parse_list) return 0;

	typ = param->sym_type;
	assert(typ != NULL);

	return typ->type_kind == void_type;
}

static int
aggs_passed_by_reference()
{
	static int initialized = 0;
	static int result;

	if (initialized) return result;

	switch (ada_compiler) {
	  case Rational:
	  case VADS:
		result = 1;
		break;
	  default:
		result = 0;
		break;
	}

	initialized = 1;
	return result;
}

static int
access_to_agg(typ)
	typeinfo_t *typ;
{
	assert(typ != NULL);

	if (typ->type_kind == pointer_to) {
		typ = typ->type_next;
		assert(typ != NULL);
		return is_aggregate(typ);
	}

	return 0;
}

static int
gen_params(params)
	symbol_t *params;
{
	symbol_t *sym;
	int largest_lhs;
	int lhs_pos;

	if (params == NULL || single_void(params)) {
		return cur_indent();
	}

	put_char('(');

	lhs_pos = cur_indent();
	largest_lhs = max_lhs_name_len(params);

	for (sym = params; sym; sym = sym->sym_parse_list) {
		indent_to(lhs_pos);
		put_string(sym->sym_ada_name);
		indent_to(largest_lhs + lhs_pos);
		put_string(": ");
		if (aggs_passed_by_reference() && access_to_agg(sym->sym_type)) {
			put_string(type_nameof(sym->sym_type->type_next, 0));
		}
		else {
			put_string(type_nameof(sym->sym_type, 0));
		}
		if (sym->sym_parse_list != NULL) {
			put_string(";\n");
		}
	}

	put_char(')');

	if (params->sym_parse_list) {
		return largest_lhs + lhs_pos + 1;
	}

	return cur_indent();
}

static typeinfo_t*
return_type(subp)
	symbol_t *subp;
{
	typeinfo_t *typ, *rtyp;

	typ = subp->sym_type;
	assert(typ != NULL);

	if (typ->type_kind != function_type) {
		warning(file_name(subp->sym_def), line_number(subp->sym_def),
				"Type not a function");
	}

	rtyp = typ->type_next;		/* return type */
	assert(rtyp != NULL);

	return rtyp;
}

static void
gen_vars(vq, import)
	sym_q *vq;
	int import;
{
	symbol_t *sym;
	int largest_lhs;

	if (vq->qhead == NULL) return;

	largest_lhs = q_max_lhs_name_len(vq);

	new_line();

	for (sym = vq->qhead; sym; sym = sym->sym_gen_list) {
		gen_var_or_field(sym, 4, largest_lhs + 4, import);
	}
}

static void
import_vars()
{
	int uord;
	int i;

	if (!should_import()) return;

	for (i = 0; ; i++) {
		uord = nth_direct_ref_unit_ord(i);
		if (uord == -1) break;
		if (compilation[uord].varq.qhead != NULL) {
			new_line();
			indent_to(ADA_TAB_STOP);
			put_string("-- imported vars from ");
			put_string(unit_name(uord));
			new_line();
			gen_vars(&compilation[uord].varq, uord);
		}
	}
}

static int
is_function(subp)
	symbol_t *subp;
{
	typeinfo_t *rtyp;
	rtyp = return_type(subp);
	return rtyp->type_kind != void_type;
}

static int
gen_1_subp_spec(sym)
	symbol_t *sym;
{
	int indent;

	new_line();
	indent_to(ADA_TAB_STOP);

	if (is_function(sym)) {
		put_string("function ");
		put_string(sym->sym_ada_name);
		indent = gen_params(sym->sym_tags);
		if (multiple_params(sym->sym_tags)) {
			new_line();
			indent_to(indent);
		}
		put_string(" return ");
		put_string(type_nameof(return_type(sym), 0));
	}
	else {
		put_string("procedure ");
		put_string(sym->sym_ada_name);
		indent = gen_params(sym->sym_tags);
	}
	return indent;
}

static void
check_unknown_function_macros(sym, import)
    symbol_t *sym;
    int import;
{
    macro_t *m, *last, *next;
    char *tmp;
    int indent;

    for (last = NULL, m = unknown_macro_list; m; m = next) {
		next = m->macro_next;
		assert(next != m);
        if(!strcmp(sym->sym_ada_name, m->macro_body)) {
            tmp = sym->sym_ada_name;
            sym->sym_ada_name = m->macro_name;
            indent = gen_1_subp_spec(sym);
            sym->sym_ada_name = tmp;

            new_line();
            indent_to(indent);
            put_string(" renames ");
            if (import != -1) {
                put_string(unit_name(import));
                put_char('.');
            }
            put_string(sym->sym_ada_name);

            put_char(';');
            c_comment(sym->sym_ident);
            print_position(sym->sym_def);

            if(last != NULL) {
                last->macro_next = next;
			} else {
                unknown_macro_list = next;
			}
        } else {
            last = m;
        }
    }
}

static void
gen_subp_specs(fq, import)
	sym_q *fq;
{
	symbol_t *sym;
	int indent;

	for (sym = fq->qhead; sym; sym = sym->sym_gen_list) {
		indent = gen_1_subp_spec(sym);

		if (import != -1) {
			new_line();
			indent_to(indent);
			put_string(" renames ");
			put_string(unit_name(import));
			put_char('.');
			put_string(sym->sym_ada_name);
		}

		put_char(';');
		c_comment(sym->sym_ident);
		print_position(sym->sym_def);
        check_unknown_function_macros(sym, import);
	}
}

static void
import_subprograms()
{
	int uord;
	int i;

	if (!should_import()) return;

	for (i = 0; ; i++) {
		uord = nth_direct_ref_unit_ord(i);
		if (uord == -1) break;
		if (compilation[uord].funcq.qhead != NULL) {
			new_line();
			indent_to(ADA_TAB_STOP);
			put_string("-- imported subprograms from ");
			put_string(unit_name(uord));
			new_line();
			gen_subp_specs(&compilation[uord].funcq, uord);
		}
	}
}

static void
rational_parameter_mechanism(params)
	symbol_t *params;
{
	if (params == NULL || single_void(params)) return;

	put_string(", mechanism => (");
	for (; params; params = params->sym_parse_list) {
		if (access_to_agg(params->sym_type)) {
			put_string("reference");
		}
		else {
			put_string("value");
		}
		if (params->sym_parse_list != NULL) {
			put_string(", ");
		}
	}

	put_char(')');
}

static void
rational_subp_interface_pragma(subp)
	symbol_t *subp;
{
	indent_to(ADA_TAB_STOP);

	put_string("pragma import_");
	put_string(is_function(subp) ? "function(" : "procedure(");
	put_string(subp->sym_ada_name);
	put_string(", \".");
	assert(subp->sym_ident != NULL);
	assert(subp->sym_ident->node_kind == _Ident);
	put_string(subp->sym_ident->node.id.name);
	put_char('\"');
	rational_parameter_mechanism(subp->sym_tags);
	put_string(");\n");
}

static void
interface_c(sym)
	symbol_t *sym;
{
	assert(sym != NULL);
	assert(sym->sym_ada_name != NULL);

	new_line();
	indent_to(ADA_TAB_STOP);

    if(ada_version >= 95) {
        indent_to(4);
        put_string("pragma Import(C, ");
        put_string(sym->sym_ada_name);
        put_string(", \"");
		put_string(C_SUBP_PREFIX);
        assert(sym->sym_ident != NULL);
        assert(sym->sym_ident->node_kind == _Ident);
        assert(sym->sym_ident->node.id.name != NULL);
        put_string(sym->sym_ident->node.id.name);
        put_string("\");");
    } else {
		put_string("pragma interface(C, ");
		put_string(sym->sym_ada_name);
		put_string(");");
	}

	print_position(sym->sym_def);
}

static void
gen_var_interface_pragmas(vq)
	sym_q *vq;
{
	symbol_t *sym;
	int indent;

	for (sym = vq->qhead; sym; sym = sym->sym_gen_list) {
		switch (ada_compiler) {
		  case GNAT:
			break;
		  case VADS:
			indent_to(ADA_TAB_STOP);
			put_string("pragma interface_name(");
			put_string(sym->sym_ada_name);
			put_string(", language.c_prefix & \"");
			assert(sym->sym_ident != NULL);
			assert(sym->sym_ident->node_kind == _Ident);
			assert(sym->sym_ident->node.id.name != NULL);
			put_string(sym->sym_ident->node.id.name);
			put_string("\");\n");
			break;
		  default:
			interface_c(sym);
			indent_to(ADA_TAB_STOP);
			put_string("pragma interface_name(");
			put_string(sym->sym_ada_name);
			put_string(", \"");
			put_string(C_VAR_PREFIX);
			assert(sym->sym_ident != NULL);
			assert(sym->sym_ident->node_kind == _Ident);
			assert(sym->sym_ident->node.id.name != NULL);
			put_string(sym->sym_ident->node.id.name);
			put_string("\");\n");
			break;
		}
	}
}

static void
gen_subp_interface_pragmas(fq)
	sym_q *fq;
{
	symbol_t *sym;
	typeinfo_t *typ, *rtyp;
	int indent;

	for (sym = fq->qhead; sym; sym = sym->sym_gen_list) {
		interface_c(sym);
		if(ada_version >= 95) continue;

		switch (ada_compiler) {
		  case VADS:
		  case Rational:
			rational_subp_interface_pragma(sym);
			break;
		  default:
			indent_to(ADA_TAB_STOP);
			put_string("pragma interface_name(");
			put_string(sym->sym_ada_name);
			put_string(", \"");
			put_string(C_SUBP_PREFIX);
			assert(sym->sym_ident != NULL);
			assert(sym->sym_ident->node_kind == _Ident);
			assert(sym->sym_ident->node.id.name != NULL);
			put_string(sym->sym_ident->node.id.name);
			put_string("\");\n");
			break;
		}
	}
}

static
has_link_with_pragma()
{
	return ada_compiler == VADS || ada_compiler == Rational;
}

static void
gen_unit(ord)
	int ord;
{
	int i, uord;
	char *unit;
	char *p;


	if (set_unit(ord)) return;
	unit = cur_unit_name();

	reset_output_line();
	reset_indent();

	put_string("with c;\n");
	put_string("with system;\n");

	if (ada_compiler == VADS) {
		put_string("with language;\n");
	}

	for (i = 0; ; i++) {
		uord = nth_ref_unit_ord(i);
		if (uord == -1) break;
		p = unit_name(uord);
		assert(p != NULL);
		put_string("with ");
		put_string(p);
		put_string(";\n");
	}

	new_line();
	put_string("package ");
	put_string(unit);
	put_string(" is\n\n");

	if (ada_compiler == ICC) {
		/* Allow C unions */
		indent_to(ADA_TAB_STOP);
		put_string("pragma anarchy;");
		comment_start();
		put_string("Allow C unions\n\n");
	}

	if (auto_package) {
		gen_macro_constants(unit_macros[ord], -1);
		import_macro_constants();
	}
	else {
		gen_macro_constants(macro_list_head, -1);
	}

	if (auto_package && import_decls) {
		import_types();
	}

	gen_simple_types(&compilation[ord].simple_typeq);
	gen_access_types(&compilation[ord].simple_ptr_typeq);
	gen_array_types(&compilation[ord].simple_array_typeq);
	gen_record_incompletes(&compilation[ord].sort_typeq);
	gen_access_types(&compilation[ord].rec_ptr_typeq);
	gen_sorted_types(&compilation[ord].sort_typeq);
	gen_vars(&compilation[ord].varq, -1);
	import_vars();
	gen_subp_specs(&compilation[ord].funcq, -1);
	import_subprograms();

	if (macro_functions) {
		if (auto_package) {
			gen_macro_functions(unit_macros[ord], -1);
			import_macro_functions();
		}
		else {
			gen_macro_functions(macro_list_head, -1);
		}
	}

	if(compilation[ord].varq.qhead != NULL
	|| compilation[ord].funcq.qhead != NULL
	|| macro_func_flag) {

		new_line();
		put_string("private\n");

		if (macro_func_flag && has_link_with_pragma()) {
			new_line();
			indent_to(ADA_TAB_STOP);
			put_string("pragma link_with(\"");
			put_string(unit);
			put_string(".o\");\n");
		}

		gen_var_interface_pragmas(&compilation[ord].varq);
		gen_subp_interface_pragmas(&compilation[ord].funcq);

		if (macro_functions) {
			interface_macro_functions(unit_macros[ord], -1);
		}
	}

	put_string("\nend ");
	put_string(unit);
	put_string(";\n");

	unit_completed();
}

static int
dependencies_clear(sym)
	symbol_t *sym;
{
	symbol_t *basetype, *tag;
	typeinfo_t *typ;

	assert(sym != NULL);

	typ = sym->sym_type;
	assert(typ != NULL);

  top:
	switch (decl_class(typ)) {
	  case pointer_decl:
		if (is_access_to_record(typ)) {
			return 1;
		}
		typ = typ->type_next;
		goto top;
	  case func_decl:
	  case array_decl:
		typ = typ->type_next;
		goto top;
	  case struct_decl:
		basetype = typ->type_base;
		assert(basetype != NULL);
		if (basetype != sym) {	/* Typedef of struct */
			return basetype->cleared;
		}
		else {
			/* Must check all tags */
			for (tag = sym->sym_tags; tag; tag = tag->sym_parse_list) {
				if (! dependencies_clear(tag)) {
					return 0;
				}
			}
		}
		break;
	  default:
		break;
	}

	return 1;
}

static int
typesort(typeq)
	sym_q *typeq;
{
	symbol_t *q = typeq->qhead;
	symbol_t *s, *last, *next;
	int changed;

	typeq->qhead = NULL;
	typeq->qtail = NULL;

	/*
	 * Loop through list possibly many times adding symbols which
	 * are ready to be generated back into the typeq.  In practice
	 * this algorithm is generally efficient, but under some pathological
	 * cases it could very bad.
	 */
	do {
		changed = 0;
		last = NULL;

		for (s = q; s; s = next) {
			next = s->sym_gen_list;

			if (dependencies_clear(s)) {
				if (last == NULL) {
					q = next;
				}
				else {
					last->sym_gen_list = next;
				}
				s->sym_gen_list = NULL;
				s->cleared = 1;
				enq(typeq, s);
				changed = 1;
			}
			else {
				last = s;
			}
		}
	} while (changed);

	if (q == NULL) {
		return 0;
	}

	for (s = q; s; s = next) {
		next = s->sym_gen_list;
		s->sym_gen_list = NULL;
		enq(typeq, s);
	}

	return 1;
}

/*
 * Sort the output order for the following types
 * so that they obey Ada semantics
 */
static void
order_types()
{
	int last, i;

	if (auto_package) {
		last = num_files();
		for (i = 0; i < last; i++) {
			if (typesort(&compilation[i].sort_typeq)) {
				warning(unit_name(i),0,order_warning);
			}
		}
	}
	else {
		if (typesort(&compilation[0].sort_typeq)) {
			warning(NULL,0,order_warning);
		}
	}
}

void
gen()
{
	gen_macro_names();
	unit_start_gen();

	order_types();

	if (auto_package) {
		int i, last;
		last = num_files();

		rethread_macros();

		for (i = 0; i < last; i++) {
			macro_func_flag = 0;
			gen_unit(i);
		}
	}
	else {
		macro_func_flag = 0;
		gen_unit(0);
	}
}