/* User-deallocate; we emit the code directly from the front-end, and the logic is the same as the previous library function: void deallocate (void *pointer, GFC_INTEGER_4 * stat) { if (!pointer) { if (stat) *stat = 1; else runtime_error ("Attempt to DEALLOCATE unallocated memory."); } else { free (pointer); if (stat) *stat = 0; } } In this front-end version, status doesn't have to be GFC_INTEGER_4. Moreover, if CAN_FAIL is true, then we will not emit a runtime error, even when no status variable is passed to us (this is used for unconditional deallocation generated by the front-end at end of each procedure). If a runtime-message is possible, `expr' must point to the original expression being deallocated for its locus and variable name. */ tree gfc_deallocate_with_status (tree pointer, tree status, bool can_fail, gfc_expr* expr) { stmtblock_t null, non_null; tree cond, tmp, error; cond = fold_build2 (EQ_EXPR, boolean_type_node, pointer, build_int_cst (TREE_TYPE (pointer), 0)); /* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise we emit a runtime error. */ gfc_start_block (&null); if (!can_fail) { tree varname; gcc_assert (expr && expr->expr_type == EXPR_VARIABLE && expr->symtree); varname = gfc_build_cstring_const (expr->symtree->name); varname = gfc_build_addr_expr (pchar_type_node, varname); error = gfc_trans_runtime_error (true, &expr->where, "Attempt to DEALLOCATE unallocated '%s'", varname); } else error = build_empty_stmt (input_location); if (status != NULL_TREE && !integer_zerop (status)) { tree status_type = TREE_TYPE (TREE_TYPE (status)); tree cond2; cond2 = fold_build2 (NE_EXPR, boolean_type_node, status, build_int_cst (TREE_TYPE (status), 0)); tmp = fold_build2 (MODIFY_EXPR, status_type, fold_build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, 1)); error = fold_build3 (COND_EXPR, void_type_node, cond2, tmp, error); } gfc_add_expr_to_block (&null, error); /* When POINTER is not NULL, we free it. */ gfc_start_block (&non_null); tmp = build_call_expr_loc (input_location, built_in_decls[BUILT_IN_FREE], 1, fold_convert (pvoid_type_node, pointer)); gfc_add_expr_to_block (&non_null, tmp); if (status != NULL_TREE && !integer_zerop (status)) { /* We set STATUS to zero if it is present. */ tree status_type = TREE_TYPE (TREE_TYPE (status)); tree cond2; cond2 = fold_build2 (NE_EXPR, boolean_type_node, status, build_int_cst (TREE_TYPE (status), 0)); tmp = fold_build2 (MODIFY_EXPR, status_type, fold_build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, 0)); tmp = fold_build3 (COND_EXPR, void_type_node, cond2, tmp, build_empty_stmt (input_location)); gfc_add_expr_to_block (&non_null, tmp); } return fold_build3 (COND_EXPR, void_type_node, cond, gfc_finish_block (&null), gfc_finish_block (&non_null)); }
rtx addr_for_mem_ref (struct mem_address *addr, addr_space_t as, bool really_expand) { enum machine_mode address_mode = targetm.addr_space.address_mode (as); rtx address, sym, bse, idx, st, off; struct mem_addr_template *templ; if (addr->step && !integer_onep (addr->step)) st = immed_double_int_const (tree_to_double_int (addr->step), address_mode); else st = NULL_RTX; if (addr->offset && !integer_zerop (addr->offset)) off = immed_double_int_const (tree_to_double_int (addr->offset), address_mode); else off = NULL_RTX; if (!really_expand) { unsigned int templ_index = TEMPL_IDX (as, addr->symbol, addr->base, addr->index, st, off); if (templ_index >= VEC_length (mem_addr_template, mem_addr_template_list)) VEC_safe_grow_cleared (mem_addr_template, gc, mem_addr_template_list, templ_index + 1); /* Reuse the templates for addresses, so that we do not waste memory. */ templ = VEC_index (mem_addr_template, mem_addr_template_list, templ_index); if (!templ->ref) { sym = (addr->symbol ? gen_rtx_SYMBOL_REF (address_mode, ggc_strdup ("test_symbol")) : NULL_RTX); bse = (addr->base ? gen_raw_REG (address_mode, LAST_VIRTUAL_REGISTER + 1) : NULL_RTX); idx = (addr->index ? gen_raw_REG (address_mode, LAST_VIRTUAL_REGISTER + 2) : NULL_RTX); gen_addr_rtx (address_mode, sym, bse, idx, st? const0_rtx : NULL_RTX, off? const0_rtx : NULL_RTX, &templ->ref, &templ->step_p, &templ->off_p); } if (st) *templ->step_p = st; if (off) *templ->off_p = off; return templ->ref; } /* Otherwise really expand the expressions. */ sym = (addr->symbol ? expand_expr (build_addr (addr->symbol, current_function_decl), NULL_RTX, address_mode, EXPAND_NORMAL) : NULL_RTX); bse = (addr->base ? expand_expr (addr->base, NULL_RTX, address_mode, EXPAND_NORMAL) : NULL_RTX); idx = (addr->index ? expand_expr (addr->index, NULL_RTX, address_mode, EXPAND_NORMAL) : NULL_RTX); gen_addr_rtx (address_mode, sym, bse, idx, st, off, &address, NULL, NULL); return address; }
/* Allocate memory, using an optional status argument. This function follows the following pseudo-code: void * allocate (size_t size, integer_type* stat) { void *newmem; if (stat) *stat = 0; // The only time this can happen is the size wraps around. if (size < 0) { if (stat) { *stat = LIBERROR_ALLOCATION; newmem = NULL; } else runtime_error ("Attempt to allocate negative amount of memory. " "Possible integer overflow"); } else { newmem = malloc (MAX (size, 1)); if (newmem == NULL) { if (stat) *stat = LIBERROR_ALLOCATION; else runtime_error ("Out of memory"); } } return newmem; } */ tree gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) { stmtblock_t alloc_block; tree res, tmp, error, msg, cond; tree status_type = status ? TREE_TYPE (TREE_TYPE (status)) : NULL_TREE; /* Evaluate size only once, and make sure it has the right type. */ size = gfc_evaluate_now (size, block); if (TREE_TYPE (size) != TREE_TYPE (size_type_node)) size = fold_convert (size_type_node, size); /* Create a variable to hold the result. */ res = gfc_create_var (prvoid_type_node, NULL); /* Set the optional status variable to zero. */ if (status != NULL_TREE && !integer_zerop (status)) { tmp = fold_build2 (MODIFY_EXPR, status_type, fold_build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, 0)); tmp = fold_build3 (COND_EXPR, void_type_node, fold_build2 (NE_EXPR, boolean_type_node, status, build_int_cst (TREE_TYPE (status), 0)), tmp, build_empty_stmt (input_location)); gfc_add_expr_to_block (block, tmp); } /* Generate the block of code handling (size < 0). */ msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ("Attempt to allocate negative amount of memory. " "Possible integer overflow")); error = build_call_expr_loc (input_location, gfor_fndecl_runtime_error, 1, msg); if (status != NULL_TREE && !integer_zerop (status)) { /* Set the status variable if it's present. */ stmtblock_t set_status_block; gfc_start_block (&set_status_block); gfc_add_modify (&set_status_block, fold_build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, LIBERROR_ALLOCATION)); gfc_add_modify (&set_status_block, res, build_int_cst (prvoid_type_node, 0)); tmp = fold_build2 (EQ_EXPR, boolean_type_node, status, build_int_cst (TREE_TYPE (status), 0)); error = fold_build3 (COND_EXPR, void_type_node, tmp, error, gfc_finish_block (&set_status_block)); } /* The allocation itself. */ gfc_start_block (&alloc_block); gfc_add_modify (&alloc_block, res, fold_convert (prvoid_type_node, build_call_expr_loc (input_location, built_in_decls[BUILT_IN_MALLOC], 1, fold_build2 (MAX_EXPR, size_type_node, size, build_int_cst (size_type_node, 1))))); msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ("Out of memory")); tmp = build_call_expr_loc (input_location, gfor_fndecl_os_error, 1, msg); if (status != NULL_TREE && !integer_zerop (status)) { /* Set the status variable if it's present. */ tree tmp2; cond = fold_build2 (EQ_EXPR, boolean_type_node, status, build_int_cst (TREE_TYPE (status), 0)); tmp2 = fold_build2 (MODIFY_EXPR, status_type, fold_build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, LIBERROR_ALLOCATION)); tmp = fold_build3 (COND_EXPR, void_type_node, cond, tmp, tmp2); } tmp = fold_build3 (COND_EXPR, void_type_node, fold_build2 (EQ_EXPR, boolean_type_node, res, build_int_cst (prvoid_type_node, 0)), tmp, build_empty_stmt (input_location)); gfc_add_expr_to_block (&alloc_block, tmp); cond = fold_build2 (LT_EXPR, boolean_type_node, size, build_int_cst (TREE_TYPE (size), 0)); tmp = fold_build3 (COND_EXPR, void_type_node, cond, error, gfc_finish_block (&alloc_block)); gfc_add_expr_to_block (block, tmp); return res; }
/* Generate code for an ALLOCATE statement when the argument is an allocatable array. If the array is currently allocated, it is an error to allocate it again. This function follows the following pseudo-code: void * allocate_array (void *mem, size_t size, integer_type *stat) { if (mem == NULL) return allocate (size, stat); else { if (stat) { free (mem); mem = allocate (size, stat); *stat = LIBERROR_ALLOCATION; return mem; } else runtime_error ("Attempting to allocate already allocated array"); } } expr must be set to the original expression being allocated for its locus and variable name in case a runtime error has to be printed. */ tree gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size, tree status, gfc_expr* expr) { stmtblock_t alloc_block; tree res, tmp, null_mem, alloc, error; tree type = TREE_TYPE (mem); if (TREE_TYPE (size) != TREE_TYPE (size_type_node)) size = fold_convert (size_type_node, size); /* Create a variable to hold the result. */ res = gfc_create_var (type, NULL); null_mem = fold_build2 (EQ_EXPR, boolean_type_node, mem, build_int_cst (type, 0)); /* If mem is NULL, we call gfc_allocate_with_status. */ gfc_start_block (&alloc_block); tmp = gfc_allocate_with_status (&alloc_block, size, status); gfc_add_modify (&alloc_block, res, fold_convert (type, tmp)); alloc = gfc_finish_block (&alloc_block); /* Otherwise, we issue a runtime error or set the status variable. */ if (expr) { tree varname; gcc_assert (expr->expr_type == EXPR_VARIABLE && expr->symtree); varname = gfc_build_cstring_const (expr->symtree->name); varname = gfc_build_addr_expr (pchar_type_node, varname); error = gfc_trans_runtime_error (true, &expr->where, "Attempting to allocate already" " allocated array '%s'", varname); } else error = gfc_trans_runtime_error (true, NULL, "Attempting to allocate already allocated" "array"); if (status != NULL_TREE && !integer_zerop (status)) { tree status_type = TREE_TYPE (TREE_TYPE (status)); stmtblock_t set_status_block; gfc_start_block (&set_status_block); tmp = build_call_expr_loc (input_location, built_in_decls[BUILT_IN_FREE], 1, fold_convert (pvoid_type_node, mem)); gfc_add_expr_to_block (&set_status_block, tmp); tmp = gfc_allocate_with_status (&set_status_block, size, status); gfc_add_modify (&set_status_block, res, fold_convert (type, tmp)); gfc_add_modify (&set_status_block, fold_build1 (INDIRECT_REF, status_type, status), build_int_cst (status_type, LIBERROR_ALLOCATION)); tmp = fold_build2 (EQ_EXPR, boolean_type_node, status, build_int_cst (status_type, 0)); error = fold_build3 (COND_EXPR, void_type_node, tmp, error, gfc_finish_block (&set_status_block)); } tmp = fold_build3 (COND_EXPR, void_type_node, null_mem, alloc, error); gfc_add_expr_to_block (block, tmp); return res; }
void do_jump (tree exp, rtx if_false_label, rtx if_true_label, int prob) { enum tree_code code = TREE_CODE (exp); rtx temp; int i; tree type; enum machine_mode mode; rtx drop_through_label = 0; switch (code) { case ERROR_MARK: break; case INTEGER_CST: temp = integer_zerop (exp) ? if_false_label : if_true_label; if (temp) emit_jump (temp); break; #if 0 /* This is not true with #pragma weak */ case ADDR_EXPR: /* The address of something can never be zero. */ if (if_true_label) emit_jump (if_true_label); break; #endif case NOP_EXPR: if (TREE_CODE (TREE_OPERAND (exp, 0)) == COMPONENT_REF || TREE_CODE (TREE_OPERAND (exp, 0)) == BIT_FIELD_REF || TREE_CODE (TREE_OPERAND (exp, 0)) == ARRAY_REF || TREE_CODE (TREE_OPERAND (exp, 0)) == ARRAY_RANGE_REF) goto normal; case CONVERT_EXPR: /* If we are narrowing the operand, we have to do the compare in the narrower mode. */ if ((TYPE_PRECISION (TREE_TYPE (exp)) < TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (exp, 0))))) goto normal; case NON_LVALUE_EXPR: case ABS_EXPR: case NEGATE_EXPR: case LROTATE_EXPR: case RROTATE_EXPR: /* These cannot change zero->nonzero or vice versa. */ do_jump (TREE_OPERAND (exp, 0), if_false_label, if_true_label, prob); break; case TRUTH_NOT_EXPR: do_jump (TREE_OPERAND (exp, 0), if_true_label, if_false_label, inv (prob)); break; case COND_EXPR: { rtx label1 = gen_label_rtx (); if (!if_true_label || !if_false_label) { drop_through_label = gen_label_rtx (); if (!if_true_label) if_true_label = drop_through_label; if (!if_false_label) if_false_label = drop_through_label; } do_pending_stack_adjust (); do_jump (TREE_OPERAND (exp, 0), label1, NULL_RTX, -1); do_jump (TREE_OPERAND (exp, 1), if_false_label, if_true_label, prob); emit_label (label1); do_jump (TREE_OPERAND (exp, 2), if_false_label, if_true_label, prob); break; } case COMPOUND_EXPR: /* Lowered by gimplify.c. */ gcc_unreachable (); case MINUS_EXPR: /* Nonzero iff operands of minus differ. */ code = NE_EXPR; /* FALLTHRU */ case EQ_EXPR: case NE_EXPR: case LT_EXPR: case LE_EXPR: case GT_EXPR: case GE_EXPR: case ORDERED_EXPR: case UNORDERED_EXPR: case UNLT_EXPR: case UNLE_EXPR: case UNGT_EXPR: case UNGE_EXPR: case UNEQ_EXPR: case LTGT_EXPR: case TRUTH_ANDIF_EXPR: case TRUTH_ORIF_EXPR: other_code: do_jump_1 (code, TREE_OPERAND (exp, 0), TREE_OPERAND (exp, 1), if_false_label, if_true_label, prob); break; case BIT_AND_EXPR: /* fold_single_bit_test() converts (X & (1 << C)) into (X >> C) & 1. See if the former is preferred for jump tests and restore it if so. */ if (integer_onep (TREE_OPERAND (exp, 1))) { tree exp0 = TREE_OPERAND (exp, 0); rtx set_label, clr_label; int setclr_prob = prob; /* Strip narrowing integral type conversions. */ while (CONVERT_EXPR_P (exp0) && TREE_OPERAND (exp0, 0) != error_mark_node && TYPE_PRECISION (TREE_TYPE (exp0)) <= TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (exp0, 0)))) exp0 = TREE_OPERAND (exp0, 0); /* "exp0 ^ 1" inverts the sense of the single bit test. */ if (TREE_CODE (exp0) == BIT_XOR_EXPR && integer_onep (TREE_OPERAND (exp0, 1))) { exp0 = TREE_OPERAND (exp0, 0); clr_label = if_true_label; set_label = if_false_label; setclr_prob = inv (prob); } else { clr_label = if_false_label; set_label = if_true_label; } if (TREE_CODE (exp0) == RSHIFT_EXPR) { tree arg = TREE_OPERAND (exp0, 0); tree shift = TREE_OPERAND (exp0, 1); tree argtype = TREE_TYPE (arg); if (TREE_CODE (shift) == INTEGER_CST && compare_tree_int (shift, 0) >= 0 && compare_tree_int (shift, HOST_BITS_PER_WIDE_INT) < 0 && prefer_and_bit_test (TYPE_MODE (argtype), TREE_INT_CST_LOW (shift))) { unsigned HOST_WIDE_INT mask = (unsigned HOST_WIDE_INT) 1 << TREE_INT_CST_LOW (shift); do_jump (build2 (BIT_AND_EXPR, argtype, arg, build_int_cstu (argtype, mask)), clr_label, set_label, setclr_prob); break; } } } /* If we are AND'ing with a small constant, do this comparison in the smallest type that fits. If the machine doesn't have comparisons that small, it will be converted back to the wider comparison. This helps if we are testing the sign bit of a narrower object. combine can't do this for us because it can't know whether a ZERO_EXTRACT or a compare in a smaller mode exists, but we do. */ if (! SLOW_BYTE_ACCESS && TREE_CODE (TREE_OPERAND (exp, 1)) == INTEGER_CST && TYPE_PRECISION (TREE_TYPE (exp)) <= HOST_BITS_PER_WIDE_INT && (i = tree_floor_log2 (TREE_OPERAND (exp, 1))) >= 0 && (mode = mode_for_size (i + 1, MODE_INT, 0)) != BLKmode && (type = lang_hooks.types.type_for_mode (mode, 1)) != 0 && TYPE_PRECISION (type) < TYPE_PRECISION (TREE_TYPE (exp)) && have_insn_for (COMPARE, TYPE_MODE (type))) { do_jump (fold_convert (type, exp), if_false_label, if_true_label, prob); break; } if (TYPE_PRECISION (TREE_TYPE (exp)) > 1 || TREE_CODE (TREE_OPERAND (exp, 1)) == INTEGER_CST) goto normal; /* Boolean comparisons can be compiled as TRUTH_AND_EXPR. */ case TRUTH_AND_EXPR: /* High branch cost, expand as the bitwise AND of the conditions. Do the same if the RHS has side effects, because we're effectively turning a TRUTH_AND_EXPR into a TRUTH_ANDIF_EXPR. */ if (BRANCH_COST (optimize_insn_for_speed_p (), false) >= 4 || TREE_SIDE_EFFECTS (TREE_OPERAND (exp, 1))) goto normal; code = TRUTH_ANDIF_EXPR; goto other_code; case BIT_IOR_EXPR: case TRUTH_OR_EXPR: /* High branch cost, expand as the bitwise OR of the conditions. Do the same if the RHS has side effects, because we're effectively turning a TRUTH_OR_EXPR into a TRUTH_ORIF_EXPR. */ if (BRANCH_COST (optimize_insn_for_speed_p (), false) >= 4 || TREE_SIDE_EFFECTS (TREE_OPERAND (exp, 1))) goto normal; code = TRUTH_ORIF_EXPR; goto other_code; /* Fall through and generate the normal code. */ default: normal: temp = expand_normal (exp); do_pending_stack_adjust (); /* The RTL optimizers prefer comparisons against pseudos. */ if (GET_CODE (temp) == SUBREG) { /* Compare promoted variables in their promoted mode. */ if (SUBREG_PROMOTED_VAR_P (temp) && REG_P (XEXP (temp, 0))) temp = XEXP (temp, 0); else temp = copy_to_reg (temp); } do_compare_rtx_and_jump (temp, CONST0_RTX (GET_MODE (temp)), NE, TYPE_UNSIGNED (TREE_TYPE (exp)), GET_MODE (temp), NULL_RTX, if_false_label, if_true_label, prob); } if (drop_through_label) { do_pending_stack_adjust (); emit_label (drop_through_label); } }
void do_jump_1 (enum tree_code code, tree op0, tree op1, rtx if_false_label, rtx if_true_label, int prob) { enum machine_mode mode; rtx drop_through_label = 0; switch (code) { case EQ_EXPR: { tree inner_type = TREE_TYPE (op0); gcc_assert (GET_MODE_CLASS (TYPE_MODE (inner_type)) != MODE_COMPLEX_FLOAT); gcc_assert (GET_MODE_CLASS (TYPE_MODE (inner_type)) != MODE_COMPLEX_INT); if (integer_zerop (op1)) do_jump (op0, if_true_label, if_false_label, inv (prob)); else if (GET_MODE_CLASS (TYPE_MODE (inner_type)) == MODE_INT && !can_compare_p (EQ, TYPE_MODE (inner_type), ccp_jump)) do_jump_by_parts_equality (op0, op1, if_false_label, if_true_label, prob); else do_compare_and_jump (op0, op1, EQ, EQ, if_false_label, if_true_label, prob); break; } case NE_EXPR: { tree inner_type = TREE_TYPE (op0); gcc_assert (GET_MODE_CLASS (TYPE_MODE (inner_type)) != MODE_COMPLEX_FLOAT); gcc_assert (GET_MODE_CLASS (TYPE_MODE (inner_type)) != MODE_COMPLEX_INT); if (integer_zerop (op1)) do_jump (op0, if_false_label, if_true_label, prob); else if (GET_MODE_CLASS (TYPE_MODE (inner_type)) == MODE_INT && !can_compare_p (NE, TYPE_MODE (inner_type), ccp_jump)) do_jump_by_parts_equality (op0, op1, if_true_label, if_false_label, inv (prob)); else do_compare_and_jump (op0, op1, NE, NE, if_false_label, if_true_label, prob); break; } case LT_EXPR: mode = TYPE_MODE (TREE_TYPE (op0)); if (GET_MODE_CLASS (mode) == MODE_INT && ! can_compare_p (LT, mode, ccp_jump)) do_jump_by_parts_greater (op0, op1, 1, if_false_label, if_true_label, prob); else do_compare_and_jump (op0, op1, LT, LTU, if_false_label, if_true_label, prob); break; case LE_EXPR: mode = TYPE_MODE (TREE_TYPE (op0)); if (GET_MODE_CLASS (mode) == MODE_INT && ! can_compare_p (LE, mode, ccp_jump)) do_jump_by_parts_greater (op0, op1, 0, if_true_label, if_false_label, inv (prob)); else do_compare_and_jump (op0, op1, LE, LEU, if_false_label, if_true_label, prob); break; case GT_EXPR: mode = TYPE_MODE (TREE_TYPE (op0)); if (GET_MODE_CLASS (mode) == MODE_INT && ! can_compare_p (GT, mode, ccp_jump)) do_jump_by_parts_greater (op0, op1, 0, if_false_label, if_true_label, prob); else do_compare_and_jump (op0, op1, GT, GTU, if_false_label, if_true_label, prob); break; case GE_EXPR: mode = TYPE_MODE (TREE_TYPE (op0)); if (GET_MODE_CLASS (mode) == MODE_INT && ! can_compare_p (GE, mode, ccp_jump)) do_jump_by_parts_greater (op0, op1, 1, if_true_label, if_false_label, inv (prob)); else do_compare_and_jump (op0, op1, GE, GEU, if_false_label, if_true_label, prob); break; case ORDERED_EXPR: do_compare_and_jump (op0, op1, ORDERED, ORDERED, if_false_label, if_true_label, prob); break; case UNORDERED_EXPR: do_compare_and_jump (op0, op1, UNORDERED, UNORDERED, if_false_label, if_true_label, prob); break; case UNLT_EXPR: do_compare_and_jump (op0, op1, UNLT, UNLT, if_false_label, if_true_label, prob); break; case UNLE_EXPR: do_compare_and_jump (op0, op1, UNLE, UNLE, if_false_label, if_true_label, prob); break; case UNGT_EXPR: do_compare_and_jump (op0, op1, UNGT, UNGT, if_false_label, if_true_label, prob); break; case UNGE_EXPR: do_compare_and_jump (op0, op1, UNGE, UNGE, if_false_label, if_true_label, prob); break; case UNEQ_EXPR: do_compare_and_jump (op0, op1, UNEQ, UNEQ, if_false_label, if_true_label, prob); break; case LTGT_EXPR: do_compare_and_jump (op0, op1, LTGT, LTGT, if_false_label, if_true_label, prob); break; case TRUTH_ANDIF_EXPR: if (if_false_label == NULL_RTX) { drop_through_label = gen_label_rtx (); do_jump (op0, drop_through_label, NULL_RTX, prob); do_jump (op1, NULL_RTX, if_true_label, prob); } else { do_jump (op0, if_false_label, NULL_RTX, prob); do_jump (op1, if_false_label, if_true_label, prob); } break; case TRUTH_ORIF_EXPR: if (if_true_label == NULL_RTX) { drop_through_label = gen_label_rtx (); do_jump (op0, NULL_RTX, drop_through_label, prob); do_jump (op1, if_false_label, NULL_RTX, prob); } else { do_jump (op0, NULL_RTX, if_true_label, prob); do_jump (op1, if_false_label, if_true_label, prob); } break; default: gcc_unreachable (); } if (drop_through_label) { do_pending_stack_adjust (); emit_label (drop_through_label); } }
tree maybe_fold_tmr (tree ref) { struct mem_address addr; bool changed = false; tree new_ref, off; get_address_description (ref, &addr); if (addr.base && TREE_CODE (addr.base) == INTEGER_CST && !integer_zerop (addr.base)) { addr.offset = fold_binary_to_constant (PLUS_EXPR, TREE_TYPE (addr.offset), addr.offset, addr.base); addr.base = NULL_TREE; changed = true; } if (addr.symbol && TREE_CODE (TREE_OPERAND (addr.symbol, 0)) == MEM_REF) { addr.offset = fold_binary_to_constant (PLUS_EXPR, TREE_TYPE (addr.offset), addr.offset, TREE_OPERAND (TREE_OPERAND (addr.symbol, 0), 1)); addr.symbol = TREE_OPERAND (TREE_OPERAND (addr.symbol, 0), 0); changed = true; } else if (addr.symbol && handled_component_p (TREE_OPERAND (addr.symbol, 0))) { HOST_WIDE_INT offset; addr.symbol = build_fold_addr_expr (get_addr_base_and_unit_offset (TREE_OPERAND (addr.symbol, 0), &offset)); addr.offset = int_const_binop (PLUS_EXPR, addr.offset, size_int (offset)); changed = true; } if (addr.index && TREE_CODE (addr.index) == INTEGER_CST) { off = addr.index; if (addr.step) { off = fold_binary_to_constant (MULT_EXPR, sizetype, off, addr.step); addr.step = NULL_TREE; } addr.offset = fold_binary_to_constant (PLUS_EXPR, TREE_TYPE (addr.offset), addr.offset, off); addr.index = NULL_TREE; changed = true; } if (!changed) return NULL_TREE; /* If we have propagated something into this TARGET_MEM_REF and thus ended up folding it, always create a new TARGET_MEM_REF regardless if it is valid in this for on the target - the propagation result wouldn't be anyway. */ new_ref = create_mem_ref_raw (TREE_TYPE (ref), TREE_TYPE (addr.offset), &addr, false); TREE_SIDE_EFFECTS (new_ref) = TREE_SIDE_EFFECTS (ref); TREE_THIS_VOLATILE (new_ref) = TREE_THIS_VOLATILE (ref); return new_ref; }
tree create_mem_ref (gimple_stmt_iterator *gsi, tree type, aff_tree *addr, tree alias_ptr_type, tree iv_cand, tree base_hint, bool speed) { tree mem_ref, tmp; struct mem_address parts; addr_to_parts (type, addr, iv_cand, base_hint, &parts, speed); gimplify_mem_ref_parts (gsi, &parts); mem_ref = create_mem_ref_raw (type, alias_ptr_type, &parts, true); if (mem_ref) return mem_ref; /* The expression is too complicated. Try making it simpler. */ if (parts.step && !integer_onep (parts.step)) { /* Move the multiplication to index. */ gcc_assert (parts.index); parts.index = force_gimple_operand_gsi (gsi, fold_build2 (MULT_EXPR, sizetype, parts.index, parts.step), true, NULL_TREE, true, GSI_SAME_STMT); parts.step = NULL_TREE; mem_ref = create_mem_ref_raw (type, alias_ptr_type, &parts, true); if (mem_ref) return mem_ref; } if (parts.symbol) { tmp = parts.symbol; gcc_assert (is_gimple_val (tmp)); /* Add the symbol to base, eventually forcing it to register. */ if (parts.base) { gcc_assert (useless_type_conversion_p (sizetype, TREE_TYPE (parts.base))); if (parts.index) { parts.base = force_gimple_operand_gsi_1 (gsi, fold_build_pointer_plus (tmp, parts.base), is_gimple_mem_ref_addr, NULL_TREE, true, GSI_SAME_STMT); } else { parts.index = parts.base; parts.base = tmp; } } else parts.base = tmp; parts.symbol = NULL_TREE; mem_ref = create_mem_ref_raw (type, alias_ptr_type, &parts, true); if (mem_ref) return mem_ref; } if (parts.index) { /* Add index to base. */ if (parts.base) { parts.base = force_gimple_operand_gsi_1 (gsi, fold_build_pointer_plus (parts.base, parts.index), is_gimple_mem_ref_addr, NULL_TREE, true, GSI_SAME_STMT); } else parts.base = parts.index; parts.index = NULL_TREE; mem_ref = create_mem_ref_raw (type, alias_ptr_type, &parts, true); if (mem_ref) return mem_ref; } if (parts.offset && !integer_zerop (parts.offset)) { /* Try adding offset to base. */ if (parts.base) { parts.base = force_gimple_operand_gsi_1 (gsi, fold_build_pointer_plus (parts.base, parts.offset), is_gimple_mem_ref_addr, NULL_TREE, true, GSI_SAME_STMT); } else parts.base = parts.offset; parts.offset = NULL_TREE; mem_ref = create_mem_ref_raw (type, alias_ptr_type, &parts, true); if (mem_ref) return mem_ref; } /* Verify that the address is in the simplest possible shape (only a register). If we cannot create such a memory reference, something is really wrong. */ gcc_assert (parts.symbol == NULL_TREE); gcc_assert (parts.index == NULL_TREE); gcc_assert (!parts.step || integer_onep (parts.step)); gcc_assert (!parts.offset || integer_zerop (parts.offset)); gcc_unreachable (); }
tree gfc_conv_constant_to_tree (gfc_expr * expr) { tree res; gcc_assert (expr->expr_type == EXPR_CONSTANT); /* If it is has a prescribed memory representation, we build a string constant and VIEW_CONVERT to its type. */ switch (expr->ts.type) { case BT_INTEGER: if (expr->representation.string) return fold_build1 (VIEW_CONVERT_EXPR, gfc_get_int_type (expr->ts.kind), gfc_build_string_const (expr->representation.length, expr->representation.string)); else return gfc_conv_mpz_to_tree (expr->value.integer, expr->ts.kind); case BT_REAL: if (expr->representation.string) return fold_build1 (VIEW_CONVERT_EXPR, gfc_get_real_type (expr->ts.kind), gfc_build_string_const (expr->representation.length, expr->representation.string)); else return gfc_conv_mpfr_to_tree (expr->value.real, expr->ts.kind, expr->is_snan); case BT_LOGICAL: if (expr->representation.string) { tree tmp = fold_build1 (VIEW_CONVERT_EXPR, gfc_get_int_type (expr->ts.kind), gfc_build_string_const (expr->representation.length, expr->representation.string)); if (!integer_zerop (tmp) && !integer_onep (tmp)) gfc_warning ("Assigning value other than 0 or 1 to LOGICAL" " has undefined result at %L", &expr->where); return fold_convert (gfc_get_logical_type (expr->ts.kind), tmp); } else return build_int_cst (gfc_get_logical_type (expr->ts.kind), expr->value.logical); case BT_COMPLEX: if (expr->representation.string) return fold_build1 (VIEW_CONVERT_EXPR, gfc_get_complex_type (expr->ts.kind), gfc_build_string_const (expr->representation.length, expr->representation.string)); else { tree real = gfc_conv_mpfr_to_tree (mpc_realref (expr->value.complex), expr->ts.kind, expr->is_snan); tree imag = gfc_conv_mpfr_to_tree (mpc_imagref (expr->value.complex), expr->ts.kind, expr->is_snan); return build_complex (gfc_typenode_for_spec (&expr->ts), real, imag); } case BT_CHARACTER: res = gfc_build_wide_string_const (expr->ts.kind, expr->value.character.length, expr->value.character.string); return res; case BT_HOLLERITH: return gfc_build_string_const (expr->representation.length, expr->representation.string); default: fatal_error ("gfc_conv_constant_to_tree(): invalid type: %s", gfc_typename (&expr->ts)); } }