/* Reallocate MEM so it has SIZE bytes of data. This behaves like the following pseudo-code: void * internal_realloc (void *mem, size_t size) { if (size < 0) runtime_error ("Attempt to allocate a negative amount of memory."); res = realloc (mem, size); if (!res && size != 0) _gfortran_os_error ("Out of memory"); if (size == 0) return NULL; return res; } */ tree gfc_call_realloc (stmtblock_t * block, tree mem, tree size) { tree msg, res, negative, nonzero, zero, null_result, tmp; tree type = TREE_TYPE (mem); 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 (type, NULL); /* size < 0 ? */ negative = fold_build2 (LT_EXPR, boolean_type_node, size, build_int_cst (size_type_node, 0)); msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ("Attempt to allocate a negative amount of memory.")); tmp = fold_build3 (COND_EXPR, void_type_node, negative, build_call_expr_loc (input_location, gfor_fndecl_runtime_error, 1, msg), build_empty_stmt (input_location)); gfc_add_expr_to_block (block, tmp); /* Call realloc and check the result. */ tmp = build_call_expr_loc (input_location, built_in_decls[BUILT_IN_REALLOC], 2, fold_convert (pvoid_type_node, mem), size); gfc_add_modify (block, res, fold_convert (type, tmp)); null_result = fold_build2 (EQ_EXPR, boolean_type_node, res, build_int_cst (pvoid_type_node, 0)); nonzero = fold_build2 (NE_EXPR, boolean_type_node, size, build_int_cst (size_type_node, 0)); null_result = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, null_result, nonzero); msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ("Out of memory")); tmp = fold_build3 (COND_EXPR, void_type_node, null_result, build_call_expr_loc (input_location, gfor_fndecl_os_error, 1, msg), build_empty_stmt (input_location)); gfc_add_expr_to_block (block, tmp); /* if (size == 0) then the result is NULL. */ tmp = fold_build2 (MODIFY_EXPR, type, res, build_int_cst (type, 0)); zero = fold_build1 (TRUTH_NOT_EXPR, boolean_type_node, nonzero); tmp = fold_build3 (COND_EXPR, void_type_node, zero, tmp, build_empty_stmt (input_location)); gfc_add_expr_to_block (block, tmp); return res; }
/* Call malloc to allocate size bytes of memory, with special conditions: + if size == 0, return a malloced area of size 1, + if malloc returns NULL, issue a runtime error. */ tree gfc_call_malloc (stmtblock_t * block, tree type, tree size) { tree tmp, msg, malloc_result, null_result, res, malloc_tree; stmtblock_t block2; 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); /* Call malloc. */ gfc_start_block (&block2); size = fold_build2_loc (input_location, MAX_EXPR, size_type_node, size, build_int_cst (size_type_node, 1)); malloc_tree = builtin_decl_explicit (BUILT_IN_MALLOC); gfc_add_modify (&block2, res, fold_convert (prvoid_type_node, build_call_expr_loc (input_location, malloc_tree, 1, size))); /* Optionally check whether malloc was successful. */ if (gfc_option.rtcheck & GFC_RTCHECK_MEM) { null_result = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, res, build_int_cst (pvoid_type_node, 0)); msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ("Memory allocation failed")); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, null_result, build_call_expr_loc (input_location, gfor_fndecl_os_error, 1, msg), build_empty_stmt (input_location)); gfc_add_expr_to_block (&block2, tmp); } malloc_result = gfc_finish_block (&block2); gfc_add_expr_to_block (block, malloc_result); if (type != NULL) res = fold_convert (type, res); return res; }
/* 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 requested) stat = 0; newmem = malloc (MAX (size, 1)); if (newmem == NULL) { if (stat) *stat = LIBERROR_ALLOCATION; else runtime_error ("Allocation would exceed memory limit"); } return newmem; } */ void gfc_allocate_using_malloc (stmtblock_t * block, tree pointer, tree size, tree status) { tree tmp, on_error, error_cond; tree status_type = status ? 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); /* If successful and stat= is given, set status to 0. */ if (status != NULL_TREE) gfc_add_expr_to_block (block, fold_build2_loc (input_location, MODIFY_EXPR, status_type, status, build_int_cst (status_type, 0))); /* The allocation itself. */ gfc_add_modify (block, pointer, fold_convert (TREE_TYPE (pointer), build_call_expr_loc (input_location, builtin_decl_explicit (BUILT_IN_MALLOC), 1, fold_build2_loc (input_location, MAX_EXPR, size_type_node, size, build_int_cst (size_type_node, 1))))); /* What to do in case of error. */ if (status != NULL_TREE) on_error = fold_build2_loc (input_location, MODIFY_EXPR, status_type, status, build_int_cst (status_type, LIBERROR_ALLOCATION)); else on_error = build_call_expr_loc (input_location, gfor_fndecl_os_error, 1, gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ("Allocation would exceed memory limit"))); error_cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pointer, build_int_cst (prvoid_type_node, 0)); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, gfc_unlikely (error_cond), on_error, build_empty_stmt (input_location)); gfc_add_expr_to_block (block, tmp); }
/* Reallocate MEM so it has SIZE bytes of data. This behaves like the following pseudo-code: void * internal_realloc (void *mem, size_t size) { res = realloc (mem, size); if (!res && size != 0) _gfortran_os_error ("Allocation would exceed memory limit"); if (size == 0) return NULL; return res; } */ tree gfc_call_realloc (stmtblock_t * block, tree mem, tree size) { tree msg, res, nonzero, zero, null_result, tmp; tree type = TREE_TYPE (mem); 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 (type, NULL); /* Call realloc and check the result. */ tmp = build_call_expr_loc (input_location, builtin_decl_explicit (BUILT_IN_REALLOC), 2, fold_convert (pvoid_type_node, mem), size); gfc_add_modify (block, res, fold_convert (type, tmp)); null_result = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, res, build_int_cst (pvoid_type_node, 0)); nonzero = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, size, build_int_cst (size_type_node, 0)); null_result = fold_build2_loc (input_location, TRUTH_AND_EXPR, boolean_type_node, null_result, nonzero); msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ("Allocation would exceed memory limit")); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, null_result, build_call_expr_loc (input_location, gfor_fndecl_os_error, 1, msg), build_empty_stmt (input_location)); gfc_add_expr_to_block (block, tmp); /* if (size == 0) then the result is NULL. */ tmp = fold_build2_loc (input_location, MODIFY_EXPR, type, res, build_int_cst (type, 0)); zero = fold_build1_loc (input_location, TRUTH_NOT_EXPR, boolean_type_node, nonzero); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, zero, tmp, build_empty_stmt (input_location)); gfc_add_expr_to_block (block, tmp); return res; }
static tree trans_runtime_error_vararg (bool error, locus* where, const char* msgid, va_list ap) { stmtblock_t block; tree tmp; tree arg, arg2; tree *argarray; tree fntype; char *message; const char *p; int line, nargs, i; location_t loc; /* Compute the number of extra arguments from the format string. */ for (p = msgid, nargs = 0; *p; p++) if (*p == '%') { p++; if (*p != '%') nargs++; } /* The code to generate the error. */ gfc_start_block (&block); if (where) { line = LOCATION_LINE (where->lb->location); asprintf (&message, "At line %d of file %s", line, where->lb->file->filename); } else asprintf (&message, "In file '%s', around line %d", gfc_source_file, input_line + 1); arg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const (message)); free (message); asprintf (&message, "%s", _(msgid)); arg2 = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const (message)); free (message); /* Build the argument array. */ argarray = XALLOCAVEC (tree, nargs + 2); argarray[0] = arg; argarray[1] = arg2; for (i = 0; i < nargs; i++) argarray[2 + i] = va_arg (ap, tree); /* Build the function call to runtime_(warning,error)_at; because of the variable number of arguments, we can't use build_call_expr_loc dinput_location, irectly. */ if (error) fntype = TREE_TYPE (gfor_fndecl_runtime_error_at); else fntype = TREE_TYPE (gfor_fndecl_runtime_warning_at); loc = where ? where->lb->location : input_location; tmp = fold_builtin_call_array (loc, TREE_TYPE (fntype), fold_build1_loc (loc, ADDR_EXPR, build_pointer_type (fntype), error ? gfor_fndecl_runtime_error_at : gfor_fndecl_runtime_warning_at), nargs + 2, argarray); gfc_add_expr_to_block (&block, tmp); return gfc_finish_block (&block); }
/* 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; newmem = malloc (MAX (size, 1)); if (newmem == NULL) { if (stat) *stat = LIBERROR_ALLOCATION; else runtime_error ("Allocation would exceed memory limit"); } return newmem; } */ tree gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) { stmtblock_t alloc_block; tree res, tmp, 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_loc (input_location, MODIFY_EXPR, status_type, fold_build1_loc (input_location, INDIRECT_REF, status_type, status), build_int_cst (status_type, 0)); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, fold_build2_loc (input_location, 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); } /* 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_loc (input_location, 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 ("Allocation would exceed memory limit")); 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_loc (input_location, EQ_EXPR, boolean_type_node, status, build_int_cst (TREE_TYPE (status), 0)); tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, status_type, fold_build1_loc (input_location, INDIRECT_REF, status_type, status), build_int_cst (status_type, LIBERROR_ALLOCATION)); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp, tmp2); } tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, fold_build2_loc (input_location, 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); gfc_add_expr_to_block (block, gfc_finish_block (&alloc_block)); return res; }
/* 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; }