main.cc

c到DHL的转换工具

/* file "main.cc" of the fixfortran 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 fixfortran.  Many of the
 *  details of fixfortran are implemented here.
 */

#define RCS_BASE_FILE main_cc

#include "fixfortran.h"
#include <limits.h>
#include <string.h>

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

INCLUDE_SUIF_COPYRIGHT

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

                Summary
                -------

        The fixfortran program is, along with sf2c and snoot, part of
        the SUIF Fortran front end.  It tries to undo some of the
        changes sf2c makes in the code to write it in C.  When
        possible, fixfortran de-linearizes the array linearizations
        sf2c does, inlines calls to max, min, absolute value, and
        imaginary part functions, finds and marks common block
        variables, and changes structures representing complex numbers
        into arrays.


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

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

boolean errors = FALSE;
char *k_io_read;
char *k_io_write;

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

static size_t max_int_str_len;
static alist *aux_var_values;
static alist *array_types;
static char *k_fixfortran_needed_aux;
static char *k_fixfortran_fixed_array_type;
static char *k_fixfortran_original_type;

/*----------------------------------------------------------------------*
    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 mark_intrinsics(global_symtab *the_symtab);
static void do_proc(tree_proc *the_tree_proc);
static void de_linearize(tree_proc *the_proc);
void fix_array_type_for_base_expr(instruction *the_instr);
void fix_array_type_for_str_base_expr(instruction *the_instr);
static void aux_sub_on_instr(instruction *the_instr, void *);
static void fix_arrays_on_node(tree_node *the_node, void *);
static void fix_arrays_on_instr(instruction *the_instr);
static void fix_arrays_on_operand(operand the_operand);
static array_type *array_type_from_aref(in_array *the_aref);
static array_type *register_type_for_base_name(char *base_name,
                                               type_node *element_type,
                                               base_symtab *the_symtab);
static array_type *array_type_for_base_name(char *base_name,
                                            type_node *base_type,
                                            unsigned *num_dimensions);
static type_node *string_type_for_base_name(char *base_name,
                                            base_symtab *the_symtab);
static array_bound bound_from_aux(var_sym *the_var);
static void fix_addresses(instruction *the_instr, void *);
static void deallocate_operand(operand to_go);
static operand build_offset_operand(array_type *the_array_type,
                                    int num_dimensions);
static char *last_field(immed_list *field_immeds);
static char *guess_base_var_name(in_array *the_array);
static void linear_form(operand *op_a, operand *op_b, operand original,
                        var_sym *the_var);
static boolean is_zero(operand the_operand);
static void nullify_operand(operand *the_operand);
static boolean is_subtracted(operand the_operand, var_sym *the_variable,
                             boolean negated);
static operand remove_subtracted_variable(operand the_operand,
                                          var_sym *the_variable,
                                          boolean negated);
static boolean operand_is_var(operand the_operand, var_sym *the_variable);
static void mark_params_call_by_ref(tree_proc *the_tree_proc);
static void fix_symtabs(base_symtab *the_symtab);
static void fix_symtab(base_symtab *the_symtab);
static boolean is_complex(type_node *the_type);
static type_node *complex_replacement(type_node *complex_type);
static void replace_complex_in_type(type_node *the_type);
static void fix_complex_refs(tree_proc *the_proc);
static void fix_complex_on_tree_node(tree_node *the_node, void *);
static void fix_complex_on_instr(instruction *the_instr, void *);
static void drop_last_field_name(instruction *the_instr);
static void fix_complex_store(in_rrr *the_store);
static operand make_re_evalable(operand the_op, tree_node *place);
static operand simplify_address(operand old_address, type_node *new_type,
                                char *name);
static boolean is_simple_var_addr(operand the_op, var_sym **the_var);
static char *new_field_name(char *desired_name, struct_type *the_struct);
static int biggest_char_array_at_offset(struct_type *the_struct, int offset);
static type_node *original_op_type(operand the_op);
static void mark_common_blocks(base_symtab *the_symtab);
static void fix_defs(suif_object *the_object);

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

extern int main(int argc, char *argv[])
  {
    int remainder = INT_MAX;
    max_int_str_len = 1;
    while (remainder >= 10)
      {
        remainder /= 10;
        ++max_int_str_len;
      }
    start_suif(argc, argv);

    ANNOTE(k_fixfortran_needed_aux,       "fixfortran needed aux",
           FALSE);
    ANNOTE(k_fixfortran_fixed_array_type, "fixfortran fixed array type",
           FALSE);
    k_fixfortran_original_type =
            lexicon->enter("fixfortran original type")->sp;
    ANNOTE(k_io_read,  "io read",  TRUE);
    ANNOTE(k_io_write, "io write", TRUE);

    if (argc < 2)
        error_line(1, NULL, "no file specifications given");
    else if (argc == 2)
        error_line(1, NULL, "no output file specification given");
    else if (argc > 3)
        error_line(1, NULL, "too many file specifications given");

    fileset->add_file(argv[1], argv[2]);
    mark_intrinsics(fileset->globals());
    fix_symtab(fileset->globals());

    fileset->reset_iter();
    while (TRUE)
      {
        file_set_entry *fse = fileset->next_file();
        if (fse == NULL)
            break;
        fse->reset_proc_iter();
        mark_constants(fse->symtab());
        fix_symtab(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, FALSE);
            do_proc(this_proc_sym->block());
            this_proc_sym->write_proc(fse);
            this_proc_sym->flush_proc();
          }
        mark_common_blocks(fse->symtab());
      }

    mark_common_blocks(fileset->globals());

    fileset->reset_iter();
    while (TRUE)
      {
        file_set_entry *fse = fileset->next_file();
        if (fse == NULL)
            break;
        walk(fse->symtab(), &fix_defs);
      }
    walk(fileset->globals(), &fix_defs);

    delete fileset;

    if (errors)
        return 1;
    else
        return 0;
  }

/*
 *  This takes an operand of the form
 *
 *    <expr>
 *
 *  and turns it into the form
 *
 *    &(<expr>[const])
 *
 *  The result is the same memory address plus const times the size, but the
 *  type changes from a pointer to an array to a pointer to the element type
 *  of the array.  If the original expression is an array reference itself
 *  and has no "fields" annotation or iteger offset, the constant array
 *  reference is tacked onto the end of the existing reference.
 *
 *  Restrictions: The type of the original expression must be a pointer to
 *  an array with lower bound of zero (i.e. a C array).
 */
extern in_array *add_const_aref(operand array_pointer, int constant)
  {
    assert(array_pointer.type()->unqual()->is_ptr());
    ptr_type *the_ptr_type = (ptr_type *)(array_pointer.type()->unqual());
    assert(the_ptr_type->ref_type()->unqual()->is_array());
    array_type *the_array_type =
            (array_type *)(the_ptr_type->ref_type()->unqual());

    type_node *new_type = the_array_type->elem_type()->ptr_to();

    if (array_pointer.is_expr())
      {
        instruction *the_instr = array_pointer.instr();
        if ((the_instr->opcode() == io_array) &&
            (the_instr->peek_annote(k_fields) == NULL))
          {
            in_array *the_array = (in_array *)the_instr;
            if (the_array->offset() == 0)
              {
                int num_elems = the_array->elem_size() /
                                the_array_type->elem_type()->size();
                unsigned num_dims = the_array->dims();
                ++num_dims;
                the_array->set_dims(num_dims);
                the_array->set_index(num_dims - 1,
                                     const_op(immed(constant), type_ptr_diff));
                the_array->set_bound(num_dims - 1,
                                     const_op(immed(num_elems),
                                              type_ptr_diff));
                the_array->set_elem_size(the_array_type->elem_type()->size());
                operand offset_operand = the_array->offset_op();
                if (!offset_operand.is_null())
                  {
                    offset_operand.remove();
                    the_array->set_offset_op(offset_operand * num_elems);
                  }
                the_array->set_result_type(new_type);
                return the_array;
              }
          }
      }

    in_array *new_array =
            new in_array(new_type, operand(), array_pointer,
                          the_array_type->elem_type()->size(), 1, 0,
                          operand());
    new_array->set_index(0, const_op(immed(constant), type_ptr_diff));
    new_array->set_bound(0, operand());
    return new_array;
  }

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

static void mark_intrinsics(global_symtab *the_symtab)
  {
    static char *pure_intrinsic_names[] =
      {
        "sin",
        "F_sin",
        "cos",
        "F_cos",
        "tan",
        "F_tan",
        "asin",
        "F_asin",
        "acos",
        "F_acos",
        "atan2",
        "F_atan2",
        "atan",
        "F_atan",
        "sinh",
        "cosh",
        "tanh",
        "log",
        "F_log",
        "sqrt",
        "F_sqrt",
        "exp",
        "F_exp",
        "r_lg10",
        "d_lg10",
        "i_sign",
        "r_sign",
        "d_sign",
        "h_mod",
        "i_mod",
        "r_mod",
        "d_mod",
        "i_nint",
        "i_dnnt",
        "r_nint",
        "d_nint",
        "r_int",
        "d_int",
        "pow_ii",
        "pow_ri",
        "pow_di",
        "pow_ci",
        "pow_zi",
        "pow_hh",
        "pow_dd",
        "pow_zz",
        "c_div",
        "z_div",
        "s_copy",
        "s_cmp",
        "s_cat",
        "r_imag",
        "d_imag",
        "r_dim",
        "sc_abs",
        "sz_abs",
        NULL
      };

    static char *intrinsic_fortran_names[] =
      {
        "DSIN", /* sin */
        "DSIN", /* F_sin */
        "DCOS", /* cos */
        "DCOS", /* F_cos */
        "DTAN", /* tan */
        "DTAN", /* F_tan */
        "DASIN", /* asin */
        "DASIN", /* F_asin */
        "DACOS", /* acos */
        "DACOS", /* F_acos */
        "DATAN2", /* atan2 */
        "DATAN2", /* F_atan2 */
        "DATAN", /* atan */
        "DATAN", /* F_atan */
        "DSINH", /* sinh */