static void
finish_equivalences (gfc_namespace *ns)
{
gfc_equiv *z, *y;
gfc_symbol *sym;
HOST_WIDE_INT offset;
unsigned HOST_WIDE_INT align;
bool dummy;
for (z = ns->equiv; z; z = z->next)
for (y = z->eq; y; y = y->eq)
{
if (y->used)
continue;
sym = z->expr->symtree->n.sym;
current_segment = get_segment_info (sym, 0);
/* All objects directly or indirectly equivalenced with this symbol. */
add_equivalences (&dummy);
/* Align the block. */
offset = align_segment (&align);
/* Ensure all offsets are positive. */
offset -= current_segment->offset & ~(align - 1);
apply_segment_offset (current_segment, offset);
/* Create the decl. */
create_common (NULL, current_segment, true);
break;
}
}
static void
finish_equivalences (gfc_namespace *ns)
{
gfc_equiv *z, *y;
gfc_symbol *sym;
gfc_common_head * c;
HOST_WIDE_INT offset;
unsigned HOST_WIDE_INT align;
bool dummy;
for (z = ns->equiv; z; z = z->next)
for (y = z->eq; y; y = y->eq)
{
if (y->used)
continue;
sym = z->expr->symtree->n.sym;
current_segment = get_segment_info (sym, 0);
/* All objects directly or indirectly equivalenced with this
symbol. */
add_equivalences (&dummy);
/* Align the block. */
offset = align_segment (&align);
/* Ensure all offsets are positive. */
offset -= current_segment->offset & ~(align - 1);
apply_segment_offset (current_segment, offset);
/* Create the decl. If this is a module equivalence, it has a
unique name, pointed to by z->module. This is written to a
gfc_common_header to push create_common into using
build_common_decl, so that the equivalence appears as an
external symbol. Otherwise, a local declaration is built using
build_equiv_decl. */
if (z->module)
{
c = gfc_get_common_head ();
/* We've lost the real location, so use the location of the
enclosing procedure. */
c->where = ns->proc_name->declared_at;
strcpy (c->name, z->module);
}
else
c = NULL;
create_common (c, current_segment, true);
break;
}
}
static void
translate_common (gfc_common_head *common, gfc_symbol *var_list)
{
gfc_symbol *sym;
segment_info *s;
segment_info *common_segment;
HOST_WIDE_INT offset;
HOST_WIDE_INT current_offset;
unsigned HOST_WIDE_INT align;
bool saw_equiv;
common_segment = NULL;
offset = 0;
current_offset = 0;
align = 1;
saw_equiv = false;
/* Add symbols to the segment. */
for (sym = var_list; sym; sym = sym->common_next)
{
current_segment = common_segment;
s = find_segment_info (sym);
/* Symbol has already been added via an equivalence. Multiple
use associations of the same common block result in equiv_built
being set but no information about the symbol in the segment. */
if (s && sym->equiv_built)
{
/* Ensure the current location is properly aligned. */
align = TYPE_ALIGN_UNIT (s->field);
current_offset = (current_offset + align - 1) &~ (align - 1);
/* Verify that it ended up where we expect it. */
if (s->offset != current_offset)
{
gfc_error ("Equivalence for '%s' does not match ordering of "
"COMMON '%s' at %L", sym->name,
common->name, &common->where);
}
}
else
{
/* A symbol we haven't seen before. */
s = current_segment = get_segment_info (sym, current_offset);
/* Add all objects directly or indirectly equivalenced with this
symbol. */
add_equivalences (&saw_equiv);
if (current_segment->offset < 0)
gfc_error ("The equivalence set for '%s' cause an invalid "
"extension to COMMON '%s' at %L", sym->name,
common->name, &common->where);
if (gfc_option.flag_align_commons)
offset = align_segment (&align);
if (offset)
{
/* The required offset conflicts with previous alignment
requirements. Insert padding immediately before this
segment. */
if (gfc_option.warn_align_commons)
{
if (strcmp (common->name, BLANK_COMMON_NAME))
gfc_warning ("Padding of %d bytes required before '%s' in "
"COMMON '%s' at %L; reorder elements or use "
"-fno-align-commons", (int)offset,
s->sym->name, common->name, &common->where);
else
gfc_warning ("Padding of %d bytes required before '%s' in "
"COMMON at %L; reorder elements or use "
"-fno-align-commons", (int)offset,
s->sym->name, &common->where);
}
}
/* Apply the offset to the new segments. */
apply_segment_offset (current_segment, offset);
current_offset += offset;
/* Add the new segments to the common block. */
common_segment = add_segments (common_segment, current_segment);
}
/* The offset of the next common variable. */
current_offset += s->length;
}
if (common_segment == NULL)
{
gfc_error ("COMMON '%s' at %L does not exist",
common->name, &common->where);
return;
}
if (common_segment->offset != 0 && gfc_option.warn_align_commons)
{
if (strcmp (common->name, BLANK_COMMON_NAME))
gfc_warning ("COMMON '%s' at %L requires %d bytes of padding; "
"reorder elements or use -fno-align-commons",
common->name, &common->where, (int)common_segment->offset);
else
gfc_warning ("COMMON at %L requires %d bytes of padding; "
"reorder elements or use -fno-align-commons",
&common->where, (int)common_segment->offset);
}
create_common (common, common_segment, saw_equiv);
}
/*
* assemble a file and load into memory
*/
Assembly* parse_file(FILE* file) {
Assembly* assembly; /* assembly structure */
int labelid; /* new label id */
Segment* current_segment; /* holds current segment */
char line[MAX_LINE]; /* holds one line */
char* items[MAX_ARGS]; /* split line into items (split on ' ' and '\t') */
int segment; /* holds current segment id */
int count, i, size; /* loop variables */
long long params[MAX_ARGS]; /* parsed items array */
char sbuffer[1024]; /* 1K string buffer */
char* sourcefile; /* current source file */
Label* label;
/* initialize variables */
assembly = new_assembly();
labelid = 0;
linenr = 0;
segment = UNKNOWN;
sourcefile = NULL;
/* read a line lines (returns nr of characters read, -1 if eof) */
while(read_line(file, line, MAX_LINE) >= 0) {
linenr++;
/* get rid of spaces/tabs in front of the line */
trim_line(line);
/* split the line on spaces/tabs */
count = split_line(line, items);
/* note: line == items[0] */
/* check if the line was not empty */
if (strlen(line) > 0) {
if (strcmp(line, "code") == 0) {
/* code segment */
segment = CODE;
current_segment = assembly->code;
} else if (strcmp(line, "bss") == 0) {
/* bss segment */
segment = BSS;
/* bss has no segment structure */
/* (no point in saving uninitialized data */
current_segment = 0;
} else if (strcmp(line, "lit") == 0) {
/* lit segment */
segment = LIT;
current_segment = assembly->lit;
} else if (strcmp(line, "data") == 0) {
/* data segment */
segment = DATA;
current_segment = assembly->data;
} else if (strcmp(line, "export") == 0) {
/* mark label as public */
if (count != 2) error(linenr, "invalid number of parameters");
label = get_label(assembly, items[1]);
/* any exported function should be included */
label->accessed = 1;
label->exported = TRUE;
} else if (strcmp(line, "import") == 0) {
/* mark label as imported */
if (count != 2) error(linenr, "invalid number of parameters");
get_label(assembly, items[1])->imported = TRUE;
} else if (segment == UNKNOWN) {
/* all other things must be in segments */
error(linenr, "code outside segment");
} else if (strcmp(line, "align") == 0) {
/* align a segment */
if (count != 2) error(linenr, "invalid number of parameters");
params[0] = parse_numeric(items[1]);
if (segment == BSS) {
/* align bss just by size */
while(assembly->bss_size % params[0]) assembly->bss_size++;
} else {
align_segment(current_segment, params[0]);
}
} else if (strcmp(line, "byte") == 0) {
/* one byte of data */
if (count != 3) error(linenr, "invalid number of parameters");
if (segment == BSS) {
error(linenr, "can't put initialized data in bss, use data segment instead");
} else {
/* parse */
params[0] = parse_numeric(items[1]);
params[1] = parse_numeric(items[2]);
/* write to segment */
MS_WriteBE(current_segment->data, params[1], (int)params[0]);
for (i = 0; i < (int)params[0]; i++) MS_WriteBit(current_segment->mask, FALSE);
}
} else if (strcmp(line, "skip") == 0) {
/* some empty space */
if (count != 2) error(linenr, "invalid number of parameters");
/* parse */
params[0] = parse_numeric(items[1]);
if (segment == BSS) {
/* for bss: just update the size */
assembly->bss_size += params[0];
} else {
/* for other segment: write zeros */
MS_Write(current_segment->data, 0, (int)params[0]);
for (i = 0; i < (int)params[0]; i++) MS_WriteBit(current_segment->mask, FALSE);
}
} else if (strcmp(line, "address") == 0) {
/* insert address to label here */
/* some empty space */
if (count != 2) error(linenr, "invalid number of parameters");
/* write the id to the current segment */
MS_WriteBE(current_segment->data, get_label(assembly, items[1])->id, PTR_SIZE);
/* needs to be resolved */
for (i = 0; i < PTR_SIZE; i++) MS_WriteBit(current_segment->mask, TRUE);
} else if (strcmp(line, "line") == 0) {
if (count < 2) error(linenr, "invalid number of parameters");
if (sourcefile == NULL) error(linenr, "file directive must precede line directive");
size = sprintf(sbuffer, "$%s:", sourcefile);
for (i = 1; i < count; i++) {
size += sprintf(sbuffer+size, "%s", items[i]);
if (i == count-1) {
sbuffer[size++] = 0;
} else {
sbuffer[size++] = ' ';
}
}
/* register debug label */
label = get_label(assembly, sbuffer);
if (label->segment == UNKNOWN) {
if (segment == BSS) {
label->location = assembly->bss_size;
} else {
label->location = current_segment->data->size;
}
label->segment = segment;
}
/* mark as debug function, set accessed to 1 to include it in the assembly */
label->accessed = 1;
label->debuginfo = LABEL_DEBUG_LINE;
} else if (strcmp(line, "file") == 0) {
if (count < 2) error(linenr, "invalid number of parameters");
size = sprintf(sbuffer, "$");
for (i = 1; i < count; i++) {
size += sprintf(sbuffer+size, "%s", items[i]);
if (i == count-1) {
sbuffer[size++] = 0;
} else {
sbuffer[size++] = ' ';
}
}
if (sourcefile != NULL) free(sourcefile);
sourcefile = malloc(size-1);
strcpy(sourcefile, sbuffer+1);
/* register debug label */
label = get_label(assembly, sbuffer);
if (segment == BSS) {
label->location = assembly->bss_size;
} else {
label->location = current_segment->data->size;
}
label->segment = segment;
/* mark as debug function, set accessed to 1 to include it in the assembly */
label->accessed = 1;
label->debuginfo = LABEL_DEBUG_FILE;
} else if (strcmp(line, "local") == 0) {
if (count < 3) error(linenr, "invalid number of parameters");
size = sprintf(sbuffer, "$");
for (i = 1; i < count; i++) {
if (i != 2) {
size += sprintf(sbuffer+size, "%s", items[i]);
if (i == count-1) {
sbuffer[size++] = 0;
} else {
sbuffer[size++] = ' ';
}
}
}
/* register debug label */
label = get_label(assembly, sbuffer);
label->location = parse_numeric(items[2]);
label->segment = UNKNOWN;
/* mark as debug function, set accessed to 1 to include it in the assembly */
label->accessed = 1;
label->debuginfo = LABEL_DEBUG_LOCAL;
} else if (strcmp(line, "param") == 0) {
if (count < 3) error(linenr, "invalid number of parameters");
size = sprintf(sbuffer, "$");
for (i = 1; i < count; i++) {
if (i != 2) {
size += sprintf(sbuffer+size, "%s", items[i]);
if (i == count-1) {
sbuffer[size++] = 0;
} else {
sbuffer[size++] = ' ';
}
}
}
/* register debug label */
label = get_label(assembly, sbuffer);
label->location = parse_numeric(items[2]);
label->segment = UNKNOWN;
/* mark as debug function, set accessed to 1 to include it in the assembly */
label->accessed = 1;
label->debuginfo = LABEL_DEBUG_PARAM;
} else if (strcmp(line, "global") == 0) {
if (count < 2) error(linenr, "invalid number of parameters");
size = sprintf(sbuffer, "$");
for (i = 1; i < count; i++) {
size += sprintf(sbuffer+size, "%s", items[i]);
if (i == count-1) {
sbuffer[size++] = 0;
} else {
sbuffer[size++] = ' ';
}
}
/* register debug label */
label = get_label(assembly, sbuffer);
label->ref = get_label(assembly, items[1]);
/* mark as debug function, set accessed to 1 to include it in the assembly */
label->accessed = 1;
label->debuginfo = LABEL_DEBUG_GLOBAL;
} else if (strcmp(line, "function") == 0) {
if (count < 2) error(linenr, "invalid number of parameters");
size = sprintf(sbuffer, "$");
for (i = 1; i < count; i++) {
size += sprintf(sbuffer+size, "%s", items[i]);
if (i == count-1) {
sbuffer[size++] = 0;
} else {
sbuffer[size++] = ' ';
}
}
/* register debug label */
label = get_label(assembly, sbuffer);
label->ref = get_label(assembly, items[1]);
/* mark as debug function, set accessed to 1 to include it in the assembly */
label->accessed = 1;
label->debuginfo = LABEL_DEBUG_FUNCTION;
} else if (strcmp(line, "label") == 0) {
/* a label; register */
if (count != 2) error(linenr, "invalid number of parameters");
if (segment == BSS) {
register_label(assembly, items[1], segment, assembly->bss_size);
} else {
register_label(assembly, items[1], segment, current_segment->data->size);
}
} else if (strcmp(line, "typedef") == 0) {
if (count < 2) error(linenr, "invalid number of parameters");
size = sprintf(sbuffer, "$");
for (i = 1; i < count; i++) {
size += sprintf(sbuffer+size, "%s", items[i]);
if (i == count-1) {
sbuffer[size++] = 0;
} else {
sbuffer[size++] = ' ';
}
}
/* register debug label */
label = get_label(assembly, sbuffer);
/* mark as debug function, set accessed to 1 to include it in the assembly */
label->accessed = 1;
label->debuginfo = LABEL_DEBUG_TYPEDEF;
} else if (strcmp(line, "field") == 0) {
if (count < 2) error(linenr, "invalid number of parameters");
size = sprintf(sbuffer, "$");
for (i = 1; i < count; i++) {
if (i != 2) {
size += sprintf(sbuffer+size, "%s", items[i]);
if (i == count-1) {
sbuffer[size++] = 0;
} else {
sbuffer[size++] = ' ';
}
}
}
/* register debug label */
label = get_label(assembly, sbuffer);
label->location = parse_numeric(items[2]);
label->segment = UNKNOWN;
/* mark as debug function, set accessed to 1 to include it in the assembly */
label->accessed = 1;
label->debuginfo = LABEL_DEBUG_FIELD;
} else {
/* not identified; should be an instruction */
write_instruction(assembly, items, count, current_segment);
}
}
}
if (sourcefile != NULL) free(sourcefile);
/* return the structure */
return assembly;
}
/*
* Application entry point
*/
int main(int argc, char **argv) {
FILE *file; /* source and destination file handle */
char* sourcefile; /* source file name */
char* targetfile; /* destination file name */
Assembly* assembly; /* assembly structure */
Label *label,*reflabel; /* temp label structure */
int i, labels; /* loop integer and label counter */
HashTableEnumeration* henum; /* temp enumeration value */
/* processor version id */
int proc_version_id;
/* flags */
BOOL is_output_file, debug, is_version_id;
/* init variables */
sourcefile = targetfile = 0;
is_output_file = debug = is_version_id = FALSE;
proc_version_id = 0;
/* parse the command line */
for (i = 1; i < argc; i++) {
if (argv[i][0] == '-') {
/* switch */
if (strcmp(&argv[i][1], "o") == 0) {
is_output_file = TRUE;
} else if (strcmp(&argv[i][1], "g") == 0) {
debug = TRUE;
} else if (strcmp(&argv[i][1], "vid") == 0) {
is_version_id = TRUE;
} else {
printf("Invalid switch %s\n", argv[i]);
printUsage();
exit(-1);
}
} else if (is_output_file) {
/* output file name */
if (targetfile == 0) {
targetfile = argv[i];
is_output_file = FALSE;
} else {
printf("Multiple output files given\n");
printUsage();
exit(-1);
}
} else if (is_version_id) {
/* version id */
if (proc_version_id == 0) {
proc_version_id = hex2bin(argv[i]);
is_version_id = FALSE;
} else {
printf("Multiple version id's given\n");
printUsage();
exit(-1);
}
} else {
/* input file name */
if (sourcefile == 0) {
sourcefile = argv[i];
} else {
printf("Multiple source files given\n");
printUsage();
exit(-1);
}
}
}
if (proc_version_id == 0x0000) proc_version_id = DEF_PROC_VERSION_ID;
/* open the source file */
file = fopen(sourcefile, "rb");
if (file == 0) {
printf("Could not open source file '%s'\n", sourcefile);
printUsage();
exit(EXIT_FAILURE);
}
/* parse file */
assembly = parse_file(file);
fclose(file);
/*
printLabels(assembly);
*/
/* write output */
file = fopen(targetfile, "wb");
if (file == 0) {
printf("Could not open target file");
exit(-1);
}
/* magic marker */
fputc('S', file); fputc('O', file); fputc('B', file); fputc('J', file);
/* make room for nr of labels (sizeof(int)) */
for (i = 0; i < sizeof(int); i++) fputc('\0', file);
/* start enumeration over the labels */
henum = HT_StartEnumeration(assembly->labels);
labels = 0; /* label counter */
while(label = (Label*)HT_GetNextItem(henum)) {
/* dereference */
reflabel = label;
while(reflabel->ref) reflabel = reflabel->ref;
if (reflabel != label) {
label->location = reflabel->location;
label->segment = reflabel->segment;
}
/* do not write nonaccessed imported labels */
if (!label->imported || label->accessed) {
/* write label to file */
/* name length */
fputc(strlen(label->name), file);
/* name */
fputs(label->name, file);
/* imported/exported flags */
if (label->exported) {
fputc(1, file);
} else if (label->imported) {
fputc(2, file);
} else if (label->debuginfo != 0) {
fputc(1+(label->debuginfo<<4), file);
} else {
fputc(0, file);
}
/* segment */
fputc((char)label->segment, file);
/* id */
fwrite(&label->id, sizeof(int), 1, file);
/* location */
fwrite(&label->location, sizeof(int), 1, file);
/* update counter */
labels++;
}
}
/* stop the enumeration */
HT_StopEnumeration(henum);
/* align the segments to 8, (to "finish" the bitmaps) */
align_segment(assembly->code, 8);
align_segment(assembly->lit, 8);
align_segment(assembly->data, 8);
/* write the binary segment data and the label masks */
/* size */
fwrite(&assembly->code->data->size, sizeof(int), 1, file);
/* data */
MS_Dump(assembly->code->data, file);
/* mask */
MS_Dump(assembly->code->mask, file);
/* size */
fwrite(&assembly->lit->data->size, sizeof(int), 1, file);
/* data */
MS_Dump(assembly->lit->data, file);
/* mask */
MS_Dump(assembly->lit->mask, file);
/* size */
fwrite(&assembly->data->data->size, sizeof(int), 1, file);
/* data */
MS_Dump(assembly->data->data, file);
/* mask */
MS_Dump(assembly->data->mask, file);
/* sizeof bss segment, segment itself contains uninitialized data, doesn't
need to be stored in assembly file */
fwrite(&assembly->bss_size, sizeof(int), 1, file);
/* write label count */
fseek(file, 4, SEEK_SET);
fwrite(&labels, sizeof(int), 1, file);
/* close output file */
fclose(file);
return 0;
}
static void
translate_common (gfc_common_head *common, gfc_symbol *var_list)
{
gfc_symbol *sym;
segment_info *s;
segment_info *common_segment;
HOST_WIDE_INT offset;
HOST_WIDE_INT current_offset;
unsigned HOST_WIDE_INT align;
unsigned HOST_WIDE_INT max_align;
bool saw_equiv;
common_segment = NULL;
current_offset = 0;
max_align = 1;
saw_equiv = false;
/* Add symbols to the segment. */
for (sym = var_list; sym; sym = sym->common_next)
{
if (sym->equiv_built)
{
/* Symbol has already been added via an equivalence. */
current_segment = common_segment;
s = find_segment_info (sym);
/* Ensure the current location is properly aligned. */
align = TYPE_ALIGN_UNIT (s->field);
current_offset = (current_offset + align - 1) &~ (align - 1);
/* Verify that it ended up where we expect it. */
if (s->offset != current_offset)
{
gfc_error ("Equivalence for '%s' does not match ordering of "
"COMMON '%s' at %L", sym->name,
common->name, &common->where);
}
}
else
{
/* A symbol we haven't seen before. */
s = current_segment = get_segment_info (sym, current_offset);
/* Add all objects directly or indirectly equivalenced with this
symbol. */
add_equivalences (&saw_equiv);
if (current_segment->offset < 0)
gfc_error ("The equivalence set for '%s' cause an invalid "
"extension to COMMON '%s' at %L", sym->name,
common->name, &common->where);
offset = align_segment (&align);
if (offset & (max_align - 1))
{
/* The required offset conflicts with previous alignment
requirements. Insert padding immediately before this
segment. */
gfc_warning ("Padding of %d bytes required before '%s' in "
"COMMON '%s' at %L", offset, s->sym->name,
common->name, &common->where);
}
else
{
/* Offset the whole common block. */
apply_segment_offset (common_segment, offset);
}
/* Apply the offset to the new segments. */
apply_segment_offset (current_segment, offset);
current_offset += offset;
if (max_align < align)
max_align = align;
/* Add the new segments to the common block. */
common_segment = add_segments (common_segment, current_segment);
}
/* The offset of the next common variable. */
current_offset += s->length;
}
if (common_segment->offset != 0)
{
gfc_warning ("COMMON '%s' at %L requires %d bytes of padding at start",
common->name, &common->where, common_segment->offset);
}
create_common (common, common_segment, saw_equiv);
}
