main.cc

c到DHL的转换工具

                       "unable to find bound variable %s", auxiliary_name);
            errors = TRUE;
          }

        operand op_a, op_b;
        linear_form(&op_a, &op_b, remaining_index, bound_var);
        remaining_index = op_b;
        new_array->set_index(num_dimensions - (dimension_num + 1), op_a);
      }

    new_array->set_index(0, remaining_index);

    delete[] auxiliary_name;

    type_node *follow_type = new_type;
    dimension_num = 0;
    while (dimension_num < num_dimensions)
      {
        assert(follow_type != NULL);
        assert(follow_type->is_array());
        array_type *follow_array = (array_type *)follow_type;

        array_bound upper_bound = follow_array->upper_bound();
        array_bound lower_bound = follow_array->lower_bound();
        operand new_bound;
        if (upper_bound.is_unknown() || lower_bound.is_unknown())
          {
            new_bound = operand();
          }
        else
          {
            new_bound = (operand_from_array_bound(upper_bound) -
                         operand_from_array_bound(lower_bound));
            new_bound = (new_bound + const_op(immed(1), new_bound.type()));
          }
        new_array->set_bound(dimension_num, new_bound);

        follow_type = follow_array->elem_type()->unqual();
        ++dimension_num;
      }

    /* handle the case of arrays of character strings */
    if (follow_type->is_array())
      {
        array_type *string_array = (array_type *)follow_type;
        if (string_array->elem_type()->unqual()->is_same(type_char))
          {
            new_array->set_dims(num_dimensions + 1);
            new_array->set_elem_size(type_char->size());

            operand upper_op =
                    operand_from_array_bound(string_array->upper_bound());
            operand lower_op =
                    operand_from_array_bound(string_array->lower_bound());
            operand difference = ((upper_op - lower_op.clone()) + 1);

            offset_operand *= difference.clone();
            offset_operand += lower_op.clone();

            new_array->set_index(num_dimensions, lower_op);
            new_array->set_bound(num_dimensions, difference);
          }
      }

    new_array->set_offset_op(offset_operand);

    replace_instruction(old_array, new_array);
    delete old_array;
  }

static void fix_arrays_on_operand(operand the_operand)
  {
    if (!the_operand.is_expr())
        return;

    fix_arrays_on_instr(the_operand.instr());
  }

static array_type *array_type_from_aref(in_array *the_aref)
  {
    type_node *base_type = the_aref->base_op().type()->unqual();
    if (base_type->is_ptr())
      {
        ptr_type *the_pointer = (ptr_type *)base_type;
        base_type = the_pointer->ref_type()->unqual();
        if (!base_type->is_array())
          {
            error_line(0, the_aref->parent(),
                       "base of array reference instruction is not a pointer"
                       " to an array");
            errors = TRUE;
            return NULL;
          }
        return (array_type *)base_type;
      }
    else
      {
        error_line(0, the_aref->parent(),
                   "base of array reference instruction is not a pointer");
        errors = TRUE;
        return NULL;
      }
  }

static array_type *register_type_for_base_name(char *base_name,
                                               type_node *element_type,
                                               base_symtab *the_symtab)
  {
    assert(base_name != NULL);
    assert(element_type != NULL);

    alist_iter type_iter(array_types);
    while (!type_iter.is_empty())
      {
        alist_e *this_alist_e = type_iter.step();
        assert(this_alist_e != NULL);
        if (strcmp((char *)(this_alist_e->key), base_name) == 0)
          {
            /*
             *  This happens whenever there are multiple entry points
             *  for a function -- sf2c repeats all the declarations
             *  once for each entry point.
             */
            unsigned dummy;
            return array_type_for_base_name(base_name, element_type, &dummy);
          }
      }

    base_symtab *new_symtab = element_type->parent();

    char *aux_lb_name = new char[strlen(base_name) + max_int_str_len + 4];
    strcpy(aux_lb_name, base_name);
    strcat(aux_lb_name, "_lb");
    char *lb_num_place = aux_lb_name + strlen(base_name) + 3;

    char *aux_ub_name = new char[strlen(base_name) + max_int_str_len + 4];
    strcpy(aux_ub_name, base_name);
    strcat(aux_ub_name, "_ub");
    char *ub_num_place = aux_ub_name + strlen(base_name) + 3;

    type_node *result = element_type;
    int dim_count = 0;
    while (TRUE)
      {
        sprintf(lb_num_place, "%d", dim_count + 1);
        var_sym *lb_var = the_symtab->lookup_var(aux_lb_name);
        if (lb_var == NULL)
            break;

        ++dim_count;

        array_type *new_type = new array_type(result);
        result = new_type;

        array_bound new_lower = bound_from_aux(lb_var);
        new_type->set_lower_bound(new_lower);
        if (new_lower.is_variable())
          {
            new_symtab = joint_symtab(new_symtab,
                                      new_lower.variable()->parent());
          }

        sprintf(ub_num_place, "%d", dim_count);
        var_sym *ub_var = the_symtab->lookup_var(aux_ub_name);
        if (ub_var == NULL)
          {
            new_type->set_upper_bound(array_bound());
            break;
          }

        array_bound new_upper = bound_from_aux(ub_var);
        new_type->set_upper_bound(new_upper);
        if (new_upper.is_variable())
          {
            new_symtab = joint_symtab(new_symtab,
                                      new_upper.variable()->parent());
          }
      }

    if (dim_count == 0)
      {
        error_line(0, NULL, "cannot find dimension variable %s", aux_lb_name);
        errors = TRUE;
        result = new array_type(element_type);
      }

    delete[] aux_lb_name;
    delete[] aux_ub_name;

    assert(new_symtab != NULL);
    array_type *installed_result =
            (array_type *)(new_symtab->install_type(result));
    array_types->enter(lexicon->enter(base_name)->sp, installed_result);
    return installed_result;
  }

static array_type *array_type_for_base_name(char *base_name,
                                            type_node *base_type,
                                            unsigned *num_dimensions)
  {
    assert(base_name != NULL);
    assert(base_type != NULL);
    assert(num_dimensions != NULL);

    alist_iter type_iter(array_types);
    while (!type_iter.is_empty())
      {
        alist_e *this_alist_e = type_iter.step();
        assert(this_alist_e != NULL);
        if (strcmp((char *)(this_alist_e->key), base_name) == 0)
          {
            array_type *result = (array_type *)(this_alist_e->info);
            int dim_count = 0;
            type_node *follow_type = result;
            while (!follow_type->is_same(base_type))
              {
                ++dim_count;
                assert(follow_type != NULL);
                if (!follow_type->is_array())
                  {
                    error_line(0, NULL,
                               "array with base name \"%s\" used with "
                               "conflicting element types", base_name);
                    errors = TRUE;
                    break;
                  }
                array_type *follow_array = (array_type *)follow_type;
                follow_type = follow_array->elem_type();
              }
            if (base_type->unqual()->is_same(type_char))
                --dim_count;
            *num_dimensions = dim_count;
            return result;
          }
      }

    error_line(0, NULL, "cannot find declaration statement for array `%s'",
               base_name);
    errors = TRUE;

    *num_dimensions = 1;
    array_type *result = new array_type(base_type);

    return (array_type *)(base_type->parent()->install_type(result));
  }

static type_node *string_type_for_base_name(char *base_name,
                                            base_symtab *the_symtab)
  {
    char *aux_name = new char[strlen(base_name) + 8];
    strcpy(aux_name, base_name);
    strcat(aux_name, "_strlen");
    var_sym *aux_var = the_symtab->lookup_var(aux_name);
    delete[] aux_name;

    if (aux_var == NULL)
        return type_char;

    array_bound new_upper = bound_from_aux(aux_var);
    type_node *result =
            new array_type(type_char, array_bound(1), new_upper);

    base_symtab *result_symtab;
    if (new_upper.is_variable())
        result_symtab = new_upper.variable()->parent();
    else
        result_symtab = fileset->globals();
    return result_symtab->install_type(result);
  }

static array_bound bound_from_aux(var_sym *the_var)
  {
    alist_e *the_alist_e = aux_var_values->search(the_var);
    if (the_alist_e == NULL)
      {
        error_line(0, NULL, "cannot find value of auxiliary variable %s",
                   the_var->name());
        errors = TRUE;
        return array_bound();
      }

    tree_instr *the_tree_instr = (tree_instr *)(the_alist_e->info);
    instruction *the_instr = the_tree_instr->instr();
    assert(the_instr != NULL);

    array_bound result;
    immed value;
    eval_status return_code = evaluate_const_instr(the_instr, &value);
    if ((return_code == EVAL_OK) && value.is_integer())
        result = array_bound(value.integer());

    if (result.is_unknown())
      {
        the_var->append_annote(k_fixfortran_needed_aux, new immed_list);
        result = array_bound(the_var);
      }

    return result;
  }

static void fix_addresses(instruction *the_instr, void *)
  {
    unsigned first_src, last_src;
    boolean is_fio = FALSE;
    boolean is_memop = FALSE;
    switch (the_instr->opcode())
      {
        case io_lod:
            first_src = 0;
            last_src = 0;
            is_memop = TRUE;
            break;
        case io_str:
        case io_memcpy:
            first_src = 0;
            last_src = 1;
            is_memop = TRUE;
            break;
        case io_cal:
          {
            first_src = 1;
            last_src = the_instr->num_srcs() - 1;
            proc_sym *call_sym = proc_for_call((in_cal *)the_instr);
            if ((call_sym != NULL) &&
                ((strcmp(call_sym->name(), "do_fio") == 0) ||
                 (strcmp(call_sym->name(), "do_lio") == 0) ||
                 (strcmp(call_sym->name(), "do_uio") == 0)))
              {
                is_fio = TRUE;
              }
            break;
          }
        default:
            return;
      }

    for (unsigned src_num = first_src; src_num <= last_src; ++src_num)
      {
        operand this_src = the_instr->src_op(src_num);
        if (!this_src.type()->unqual()->is_ptr())
            continue;

        type_node *original_type = original_op_type(this_src);
        ptr_type *src_ptr = (ptr_type *)(this_src.type()->unqual());
        in_rrr *old_cvt = NULL;
        if (is_fio && this_src.is_expr() &&
            (this_src.instr()->opcode() == io_cvt) &&
            (src_ptr->ref_type()->op() == TYPE_INT) &&
            (src_ptr->ref_type()->size() == target.size[C_char]))
          {
            old_cvt = (in_rrr *)(this_src.instr());
            this_src = old_cvt->src_op();
            src_ptr = (ptr_type *)(this_src.type()->unqual());
          }
        this_src.remove();
        this_src = simplify_address(this_src, src_ptr->ref_type(), NULL);
        if (is_memop && (this_src.type() != src_ptr))
            this_src = fold_real_1op_rrr(io_cvt, original_type, this_src);
        if (old_cvt != NULL)
            old_cvt->set_src(this_src);
        else
            the_instr->set_src_op(src_num, this_src);
      }

    switch (the_instr->opcode())
      {
        case io_lod:
          {
            in_rrr *the_load = (in_rrr *)the_instr;
            var_sym *loaded_var;
            boolean is_var =
                    is_simple_var_addr(the_load->src_addr_op(), &loaded_var);
            if (is_var)
              {
                if (the_load->dst_op().is_instr())
                  {
                    instruction *parent_instr = the_load->dst_op().instr();
                    unsigned num_srcs = parent_instr->num_srcs();
                    unsigned src_num;
                    for (src_num = 0; src_num < num_srcs; ++src_num)
                      {
                        if (parent_instr->src_op(src_num) == operand(the_load))
                            break;
                      }
                    the_load->remove();