a few more warnings

[suif.git] / src / basesuif / cbsplit / main.cc

/* file "main.cc" of the cbsplit program for SUIF */ 

/*  Copyright (c) 1994 Stanford University

    All rights reserved.

    This software is provided under the terms described in
    the "suif_copyright.h" include file. */

#include <suif_copyright.h>

/*
 *  This file contains the main program for cbsplit.
 */

#define RCS_BASE_FILE main_cc

#include <suif1.h>
#include <useful.h>
#include <string.h>

RCS_BASE(
    "$Id: main.cc,v 1.1.1.1 1998/06/16 15:17:10 brm Exp $")

INCLUDE_SUIF_COPYRIGHT

/*----------------------------------------------------------------------*
    Begin Documentation
 *----------------------------------------------------------------------*

                Summary
                -------

        The cbsplit program splits up Fortran common blocks into
        pieces that are as small as possible, given the reshaping in
        the program.  This can in many cases lead to common blocks
        which consist of only one field, in which case a single global
        variable of the appropriate type can be used.  The idea is
        that some interprocedural analysis that deals only with
        var_syms and can't handle the offsets and overlapping of a
        common block will be able to do more because more things will
        be in their own var_syms.

        Note that to be correct, this pass must know how all the
        functions in the entire program use their common blocks before
        it can split anything.  Hence if the program is in multiple
        files, the files must be linked before this pass is run and
        this pass should be run on all simultaneously.


            Options
            -------

        -assume-no-reshape-communication
                Assume that if there is any reshaping of common
                blocks, either through equivalences or different
                shapes in different procedures, that there is no
                communication from one shape to another.  That is,
                assume it is safe to make different shapes not overlap
                one another at all.  With this assumption, every field
                of every common block is made into its own independent
                global variable unless there is some initialization
                data for the common block.  If the common block has
                initialization data, it is handled as if this flag
                weren't used.


 *----------------------------------------------------------------------*
    End Documentation
 *----------------------------------------------------------------------*/
/*----------------------------------------------------------------------*
    Begin Private Type Definitions
 *----------------------------------------------------------------------*/

class chunk_data
  {
public:
    int offset;
    int size;
    boolean is_unit;
    var_sym *replacement;
    chunk_data *next;

    chunk_data(int new_offset, int new_size, chunk_data *new_next)
      {
        offset = new_offset;
        size = new_size;
        is_unit = FALSE;
        replacement = NULL;
        next = new_next;
      }
  };

/*----------------------------------------------------------------------*
    End Private Type Definitions
 *----------------------------------------------------------------------*/
/*----------------------------------------------------------------------*
    Begin Public Global Variables
 *----------------------------------------------------------------------*/

/*----------------------------------------------------------------------*
    End Public Global Variables
 *----------------------------------------------------------------------*/
/*----------------------------------------------------------------------*
    Begin Private Global Variables
 *----------------------------------------------------------------------*/

static char *k_cbsplit_data = "cbsplit data";
boolean assume_no_reshape_communication = FALSE;

/*----------------------------------------------------------------------*
    End Private Global Variables
 *----------------------------------------------------------------------*/
/*----------------------------------------------------------------------*
    Begin Public Function Declarations
 *----------------------------------------------------------------------*/

extern int main(int argc, char *argv[]);

/*----------------------------------------------------------------------*
    End Public Function Declarations
 *----------------------------------------------------------------------*/
/*----------------------------------------------------------------------*
    Begin Private Function Declarations
 *----------------------------------------------------------------------*/

static void usage(void);
static void split_blocks(global_symtab *the_symtab);
static void split_common_block(var_sym *the_common);
static chunk_data *group_split_common(struct_type *the_struct);
static chunk_data *fix_partition_for_initialization(chunk_data *partition,
               base_init_struct_list *initializers);
static struct_type *struct_section(struct_type *original_struct, int offset,
                                   int size, boolean *is_unit,
                                   type_node **unit_type, 
                                   const char **unit_name);
static void split_on_proc(tree_proc *);

/*----------------------------------------------------------------------*
    End Private Function Declarations
 *----------------------------------------------------------------------*/
/*----------------------------------------------------------------------*
    Begin Public Function Implementations
 *----------------------------------------------------------------------*/

extern int main(int argc, char *argv[])
  {
    static cmd_line_option option_table[] =
      {
        {CLO_NOARG, "-assume-no-reshape-communication", NULL,
                 &assume_no_reshape_communication}
      };

    start_suif(argc, argv);

    parse_cmd_line(argc, argv, option_table,
                   sizeof(option_table) / sizeof(cmd_line_option));

    if ((argc < 3) || (argc % 2 != 1))
        usage();

    for (int arg_num = 1; arg_num < argc; arg_num += 2)
        fileset->add_file(argv[arg_num], argv[arg_num + 1]);

    split_blocks(fileset->globals());

    fileset->reset_iter();
    while (TRUE)
      {
        file_set_entry *fse = fileset->next_file();
        if (fse == NULL)
            break;
        split_blocks(fse->symtab());
        fse->reset_proc_iter();
        while (TRUE)
          {
            proc_sym *this_proc_sym = fse->next_proc();
            if (this_proc_sym == NULL)
                break;
            this_proc_sym->read_proc(TRUE, TRUE);
            split_on_proc(this_proc_sym->block());
            this_proc_sym->write_proc(fse);
            this_proc_sym->flush_proc();
          }
      }

    exit_suif();
    return 0;
  }

/*----------------------------------------------------------------------*
    End Public Function Implementations
 *----------------------------------------------------------------------*/
/*----------------------------------------------------------------------*
    Begin Private Function Implementations
 *----------------------------------------------------------------------*/

static void usage(void)
  {
    fprintf(stderr,
            "usage: %s { -assume-no-reshape-communication } "
            "<infile> <outfile> { <infile> <outfile> }*\n",
            _suif_prog_base_name);
    exit(1);
  }

static void split_blocks(global_symtab *the_symtab)
  {
    sym_node_list_iter sym_iter(the_symtab->symbols());
    while (!sym_iter.is_empty())
      {
        sym_node *this_symbol = sym_iter.step();

        if (!this_symbol->is_var())
            continue;
        var_sym *this_var = (var_sym *)this_symbol;

        if (this_var->peek_annote(k_common_block) != NULL)
            split_common_block(this_var);
      }

    the_symtab->number_globals();
  }

static void split_common_block(var_sym *the_common)
  {
    type_node *common_type = the_common->type();
    if (common_type->op() != TYPE_GROUP)
        error_line(1, the_common, "common block does not have group type");
    struct_type *common_group = (struct_type *)common_type;

    if (!the_common->has_var_def())
      {
        error_line(1, NULL, "no definition for common block `%s'",
                   the_common->name());
      }
    var_def *old_def = the_common->definition();
    if (old_def == NULL)
      {
        error_line(1, NULL, "no definition for common block `%s'",
                   the_common->name());
      }

    base_init_struct_list *initializers = read_init_data(old_def);

    if (assume_no_reshape_communication && initializers->is_empty())
      {
        while (the_common->num_children() > 0)
          {
            var_sym *this_child = the_common->child_var(0);
            the_common->remove_child(this_child);
            old_def->parent()->define_var(this_child,
                                          get_alignment(this_child->type()));
          }
        return;
      }

    chunk_data *the_data = group_split_common(common_group);

    the_data = fix_partition_for_initialization(the_data, initializers);

    if (the_data == NULL)
      {
        deallocate_init_data(initializers);
        return;
      }

    /*
     *  If the split would just give back one chunk of the same size,
     *  don't do anything.
     */
    if ((the_data->next == NULL) &&
        (the_data->size == the_common->type()->size()) &&
        (common_group->num_fields() != 1))
      {
        delete the_data;
        deallocate_init_data(initializers);
        return;
      }

    int initializer_offset = 0;

    chunk_data *follow_chunk = the_data;
    while (follow_chunk != NULL)
      {
        type_node *new_type;
        boolean is_unit = TRUE;
        type_node *unit_type = NULL;
        const char *unit_name = NULL;

        new_type = struct_section(common_group, follow_chunk->offset,
                                  follow_chunk->size, &is_unit, &unit_type,
                                  &unit_name);
        assert(new_type != NULL);

        if (unit_type != NULL)
          {
            assert(new_type->parent() == NULL);
            delete new_type;
            new_type = unit_type;

            follow_chunk->is_unit = TRUE;

            unsigned num_children = the_common->num_children();
            unsigned child_num;
            for (child_num = 0; child_num < num_children; ++child_num)
              {
                if ((the_common->child_var(child_num)->offset() ==
                     follow_chunk->offset) &&
                    (the_common->child_var(child_num)->type() == unit_type))
                  {
                    break;
                  }
              }

            /*
             * Add an underscore after the name to avoid name
             * conflicts, because we are adding external linkage.  For
             * example, a field named ``time'' would conflict with the
             * C library ``time()'' function if we didn't add the
             * underscore.  Since sf2c just adds a single underscore
             * to all function names, we can assume that a trailing
             * underscore is enough to avoid conflict with library
             * symbols, and since we require all non-library source
             * files for this pass, we can assume that the SUIF
             * library will take care of any name conflicts in the
             * SUIF global symbol table.
             */
            char *new_var_name = new char[strlen(unit_name) + 2];
            sprintf(new_var_name, "%s_", unit_name);

            if (child_num < num_children)
              {
                var_sym *child_var = the_common->child_var(child_num);
                the_common->remove_child(child_var);
                child_var->set_name(new_var_name);
                follow_chunk->replacement = child_var;
              }
            else
              {
                follow_chunk->replacement =
                        the_common->parent()->new_var(new_type, new_var_name);
              }
            delete[] new_var_name;
          }
        else
          {
            new_type = common_group->parent()->install_type(new_type);

            char *new_var_name = new char[strlen(the_common->name()) + 40];
            sprintf(new_var_name, "%s_%d_%d", the_common->name(),
                    follow_chunk->offset, follow_chunk->size);
            follow_chunk->replacement =
                    the_common->parent()->new_var(new_type, new_var_name);
            follow_chunk->replacement->reset_addr_taken();
            delete[] new_var_name;

            follow_chunk->replacement->append_annote(k_common_block,
                                                     new immed_list);

            unsigned num_children = the_common->num_children();
            for (unsigned child_num = 0; child_num < num_children;)
              {
                var_sym *child_var = the_common->child_var(child_num);
                if ((child_var->offset() >= follow_chunk->offset) &&
                    ((child_var->offset() + child_var->type()->size()) <=
                     (follow_chunk->offset + follow_chunk->size)))
                  {
                    int new_offset =
                            child_var->offset() - follow_chunk->offset;
                    the_common->remove_child(child_var);
                    if (child_var->is_addr_taken())
                        follow_chunk->replacement->set_addr_taken();
                    follow_chunk->replacement->add_child(child_var,
                                                         new_offset);
                    --num_children;
                  }
                else
                  {
                    ++child_num;
                  }
              }
          }

        var_def *chunk_def =
                old_def->parent()->define_var(follow_chunk->replacement,
                                              get_alignment(new_type));

        base_init_struct_list *first_init;
        base_init_struct_list *second_init;
        boolean init_fit =
                split_init_data(initializers,
                                follow_chunk->offset - initializer_offset,
                                &first_init, &second_init);
        if (!init_fit)
          {
            error_line(1, NULL,
                       "misalignment of initialization data on common block "
                       "`%s'", the_common->name());
          }
        deallocate_init_data(first_init);

        init_fit = split_init_data(second_init, follow_chunk->size,
                                   &first_init, &initializers);
        if (!init_fit)
          {
            error_line(1, NULL,
                       "misalignment of initialization data on common block "
                       "`%s'", the_common->name());
          }
        write_init_data(chunk_def, first_init);
        deallocate_init_data(first_init);

        initializer_offset = follow_chunk->offset + follow_chunk->size;

        follow_chunk = follow_chunk->next;
      }

    assert(the_common->num_children() == 0);

    deallocate_init_data(initializers);

    the_common->append_annote(k_cbsplit_data, the_data);
  }

static chunk_data *group_split_common(struct_type *the_struct)
  {
    assert(the_struct->op() == TYPE_GROUP);

    chunk_data *new_partition = NULL;

    unsigned num_fields = the_struct->num_fields();
    for (unsigned field_num = 0; field_num < num_fields; ++field_num)
      {
        int this_offset = the_struct->offset(field_num);
        int this_size = the_struct->field_type(field_num)->size();

        chunk_data **next_place = &new_partition;

        while ((*next_place != NULL) &&
               ((*next_place)->offset + (*next_place)->size <= this_offset))
          {
            next_place = &((*next_place)->next);
          }

        if (*next_place == NULL)
          {
            *next_place = new chunk_data(this_offset, this_size, NULL);
          }
        else
          {
            if ((*next_place)->offset >= this_offset + this_size)
              {
                *next_place =
                        new chunk_data(this_offset, this_size, *next_place);
              }
            else
              {
                if ((*next_place)->offset > this_offset)
                    (*next_place)->offset = this_offset;

                while ((*next_place)->next != NULL)
                  {
                    chunk_data *next_block = (*next_place)->next;
                    if (next_block->offset >= this_offset + this_size)
                        break;
                    (*next_place)->size =
                            (next_block->offset + next_block->size) -
                            (*next_place)->offset;
                    (*next_place)->next = next_block->next;
                    delete next_block;
                  }

                if (((*next_place)->offset + (*next_place)->size) <
                    (this_offset + this_size))
                  {
                    (*next_place)->size =
                            (this_offset + this_size) - (*next_place)->offset;
                  }
              }
          }
      }

    return new_partition;
  }

static chunk_data *fix_partition_for_initialization(chunk_data *partition,
               base_init_struct_list *initializers)
  {
    chunk_data *new_partition = partition;

    base_init_struct_list_iter init_iter(initializers);
    int this_offset = 0;
    while (!init_iter.is_empty())
      {
        base_init_struct *this_init = init_iter.step();
        int this_size;
        int repetitions = 0;
        if (this_init->the_multi_init() != NULL)
          {
            this_size = this_init->the_multi_init()->size;
            repetitions = this_init->the_multi_init()->data->count();
          }
        else if (this_init->the_repeat_init() != NULL)
          {
            this_size = this_init->the_repeat_init()->size;
            repetitions = this_init->the_repeat_init()->repetitions;
          }
        else
          {
            this_offset += this_init->total_size();
          }

        while (repetitions > 0)
          {
            chunk_data **next_place = &new_partition;

            while ((*next_place != NULL) &&
                   ((*next_place)->offset + (*next_place)->size <=
                    this_offset))
              {
                next_place = &((*next_place)->next);
              }

            if (*next_place == NULL)
              {
                *next_place = new chunk_data(this_offset, this_size, NULL);
              }
            else
              {
                if ((*next_place)->offset >= this_offset + this_size)
                  {
                    *next_place =
                            new chunk_data(this_offset, this_size,
                                           *next_place);
                  }
                else
                  {
                    if ((*next_place)->offset > this_offset)
                        (*next_place)->offset = this_offset;

                    while ((*next_place)->next != NULL)
                      {
                        chunk_data *next_block = (*next_place)->next;
                        if (next_block->offset >= this_offset + this_size)
                            break;
                        (*next_place)->size =
                                (next_block->offset + next_block->size) -
                                (*next_place)->offset;
                        (*next_place)->next = next_block->next;
                        delete next_block;
                      }

                    if (((*next_place)->offset + (*next_place)->size) <
                        (this_offset + this_size))
                      {
                        (*next_place)->size =
                                (this_offset + this_size) -
                                (*next_place)->offset;
                      }
                  }
              }

            this_offset += this_size;
            --repetitions;
          }
      }

    return new_partition;
  }

static struct_type *struct_section(struct_type *original_struct, int offset,
                                   int size, boolean *is_unit,
                                   type_node **unit_type, 
                                   const char **unit_name)
  {
    assert(original_struct->is_struct());

    char *new_name = new char[strlen(original_struct->name()) + 40];
    sprintf(new_name, "%s_%d_%d", original_struct->name(), offset, size);
    struct_type *new_struct = new struct_type(TYPE_GROUP, size, new_name, 0);
    delete[] new_name;

    unsigned num_fields = original_struct->num_fields();
    for (unsigned field_num = 0; field_num < num_fields; ++field_num)
      {
        int this_offset = original_struct->offset(field_num);
        if ((this_offset >= offset) && (this_offset < offset + size))
          {
            unsigned new_field_num = new_struct->num_fields();
            type_node *new_field_type = original_struct->field_type(field_num);
            const char *new_field_name = original_struct->field_name(field_num);
            new_struct->set_num_fields(new_field_num + 1);
            new_struct->set_field_name(new_field_num, new_field_name);
            new_struct->set_field_type(new_field_num, new_field_type);
            new_struct->set_offset(new_field_num, this_offset - offset);

            if ((*is_unit))
              {
                if (this_offset != offset)
                  {
                    *is_unit = FALSE;
                    *unit_type = NULL;
                  }
                else
                  {
                    if (*unit_type == NULL)
                      {
                        *unit_type = new_field_type;
                        *unit_name = new_field_name;
                      }
                    else if (*unit_type != new_field_type)
                      {
                        *is_unit = FALSE;
                        *unit_type = NULL;
                      }
                  }
              }
          }
      }

    return new_struct;
  }

static void split_on_proc(tree_proc *)
  {
  }

/*----------------------------------------------------------------------*
    End Private Function Implementations
 *----------------------------------------------------------------------*/