#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);
}
}
syntax highlighted by Code2HTML, v. 0.9.1