Skip to content

R
riscv-gcc-1
Commit 989ea525 by Nathan Froyd Committed by Nathan Froyd
Options

vec.h (VEC_splice, [...]): New macros. 

gcc/
	* vec.h (VEC_splice, VEC_safe_splice): New macros.  Add function
	implementations.

gcc/fortran/
	* trans.h (gfc_conv_procedure_call): Take a VEC instead of a tree.
	* trans-intrinsic.c (gfc_conv_intrinsic_funcall): Adjust for new
	type of gfc_conv_procedure_call.
	(conv_generic_with_optional_char_arg): Likewise.
	* trans-stmt.c (gfc_trans_call): Likewise.
	* trans-expr.c (gfc_conv_function_expr): Likewise.
	(gfc_conv_procedure_call): Use build_call_vec instead of
	build_call_list.

From-SVN: r161834
parent 7ec6356e
Showing with 155 additions and 43 deletions
gcc/ChangeLog
2010-07-05 Nathan Froyd <froydnj@codesourcery.com>
* vec.h (VEC_splice, VEC_safe_splice): New macros. Add function
implementations.
2010-07-05 Bernd Schmidt <bernds@codesourcery.com>
* config/arm/arm.c (get_arm_condition_code): Remove CC_NOTBmode case.
......
gcc/fortran/ChangeLog
2010-07-05 Nathan Froyd <froydnj@codesourcery.com>
* trans.h (gfc_conv_procedure_call): Take a VEC instead of a tree.
* trans-intrinsic.c (gfc_conv_intrinsic_funcall): Adjust for new
type of gfc_conv_procedure_call.
(conv_generic_with_optional_char_arg): Likewise.
* trans-stmt.c (gfc_trans_call): Likewise.
* trans-expr.c (gfc_conv_function_expr): Likewise.
(gfc_conv_procedure_call): Use build_call_vec instead of
build_call_list.
2010-07-04 Daniel Kraft <d@domob.eu>
* gfc-internals.texi (gfc_code): Document BLOCK and ASSOCIATE.
......
gcc/fortran/trans-expr.c
......@@ -2653,7 +2653,6 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
return 0;
}
/* Generate code for a procedure call. Note can return se->post != NULL.
If se->direct_byref is set then se->expr contains the return parameter.
Return nonzero, if the call has alternate specifiers.
......@@ -2662,11 +2661,11 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
int
gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_actual_arglist * arg, gfc_expr * expr,
tree append_args)
VEC(tree,gc) *append_args)
{
gfc_interface_mapping mapping;
tree arglist;
tree retargs;
VEC(tree,gc) *arglist;
VEC(tree,gc) *retargs;
tree tmp;
tree fntype;
gfc_se parmse;
......@@ -2677,7 +2676,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
tree type;
tree var;
tree len;
tree stringargs;
VEC(tree,gc) *stringargs;
tree result = NULL;
gfc_formal_arglist *formal;
int has_alternate_specifier = 0;
......@@ -2690,10 +2689,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
stmtblock_t post;
enum {MISSING = 0, ELEMENTAL, SCALAR, SCALAR_POINTER, ARRAY};
gfc_component *comp = NULL;
int arglen;
arglist = NULL_TREE;
retargs = NULL_TREE;
stringargs = NULL_TREE;
arglist = NULL;
retargs = NULL;
stringargs = NULL;
var = NULL_TREE;
len = NULL_TREE;
gfc_clear_ts (&ts);
......@@ -3136,9 +3136,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* Character strings are passed as two parameters, a length and a
pointer - except for Bind(c) which only passes the pointer. */
if (parmse.string_length != NULL_TREE && !sym->attr.is_bind_c)
stringargs = gfc_chainon_list (stringargs, parmse.string_length);
VEC_safe_push (tree, gc, stringargs, parmse.string_length);
arglist = gfc_chainon_list (arglist, parmse.expr);
VEC_safe_push (tree, gc, arglist, parmse.expr);
}
gfc_finish_interface_mapping (&mapping, &se->pre, &se->post);
......@@ -3160,7 +3160,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
For dummies, we have to look through the formal argument list for
this function and use the character length found there.*/
if (!sym->attr.dummy)
cl.backend_decl = TREE_VALUE (stringargs);
cl.backend_decl = VEC_index (tree, stringargs, 0);
else
{
formal = sym->ns->proc_name->formal;
......@@ -3213,7 +3213,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
result = build_fold_indirect_ref_loc (input_location,
se->expr);
retargs = gfc_chainon_list (retargs, se->expr);
VEC_safe_push (tree, gc, retargs, se->expr);
}
else if (comp && comp->attr.dimension)
{
......@@ -3237,7 +3237,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* Pass the temporary as the first argument. */
result = info->descriptor;
tmp = gfc_build_addr_expr (NULL_TREE, result);
retargs = gfc_chainon_list (retargs, tmp);
VEC_safe_push (tree, gc, retargs, tmp);
}
else if (!comp && sym->result->attr.dimension)
{
......@@ -3261,7 +3261,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* Pass the temporary as the first argument. */
result = info->descriptor;
tmp = gfc_build_addr_expr (NULL_TREE, result);
retargs = gfc_chainon_list (retargs, tmp);
VEC_safe_push (tree, gc, retargs, tmp);
}
else if (ts.type == BT_CHARACTER)
{
......@@ -3288,7 +3288,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
else
var = gfc_conv_string_tmp (se, type, len);
retargs = gfc_chainon_list (retargs, var);
VEC_safe_push (tree, gc, retargs, var);
}
else
{
......@@ -3296,25 +3296,31 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
type = gfc_get_complex_type (ts.kind);
var = gfc_build_addr_expr (NULL_TREE, gfc_create_var (type, "cmplx"));
retargs = gfc_chainon_list (retargs, var);
VEC_safe_push (tree, gc, retargs, var);
}
/* Add the string length to the argument list. */
if (ts.type == BT_CHARACTER)
retargs = gfc_chainon_list (retargs, len);
VEC_safe_push (tree, gc, retargs, len);
}
gfc_free_interface_mapping (&mapping);
/* We need to glom RETARGS + ARGLIST + STRINGARGS + APPEND_ARGS. */
arglen = (VEC_length (tree, arglist)
+ VEC_length (tree, stringargs) + VEC_length (tree, append_args));
VEC_reserve_exact (tree, gc, retargs, arglen);
/* Add the return arguments. */
arglist = chainon (retargs, arglist);
VEC_splice (tree, retargs, arglist);
/* Add the hidden string length parameters to the arguments. */
arglist = chainon (arglist, stringargs);
VEC_splice (tree, retargs, stringargs);
/* We may want to append extra arguments here. This is used e.g. for
calls to libgfortran_matmul_??, which need extra information. */
if (append_args != NULL_TREE)
arglist = chainon (arglist, append_args);
if (!VEC_empty (tree, append_args))
VEC_splice (tree, retargs, append_args);
arglist = retargs;
/* Generate the actual call. */
conv_function_val (se, sym, expr);
......@@ -3338,7 +3344,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
}
fntype = TREE_TYPE (TREE_TYPE (se->expr));
se->expr = build_call_list (TREE_TYPE (fntype), se->expr, arglist);
se->expr = build_call_vec (TREE_TYPE (fntype), se->expr, arglist);
/* If we have a pointer function, but we don't want a pointer, e.g.
something like
......@@ -3786,8 +3792,7 @@ gfc_conv_function_expr (gfc_se * se, gfc_expr * expr)
if (!sym)
sym = expr->symtree->n.sym;
gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr,
NULL_TREE);
gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr, NULL);
}
......
gcc/fortran/trans-intrinsic.c
......@@ -1570,7 +1570,7 @@ static void
gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
{
gfc_symbol *sym;
tree append_args;
VEC(tree,gc) *append_args;
gcc_assert (!se->ss || se->ss->expr == expr);
......@@ -1583,7 +1583,7 @@ gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
/* Calls to libgfortran_matmul need to be appended special arguments,
to be able to call the BLAS ?gemm functions if required and possible. */
append_args = NULL_TREE;
append_args = NULL;
if (expr->value.function.isym->id == GFC_ISYM_MATMUL
&& sym->ts.type != BT_LOGICAL)
{
......@@ -1611,19 +1611,19 @@ gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
gemm_fndecl = gfor_fndecl_zgemm;
}
append_args = gfc_chainon_list (NULL_TREE, build_int_cst (cint, 1));
append_args = gfc_chainon_list
(append_args, build_int_cst
(cint, gfc_option.blas_matmul_limit));
append_args = gfc_chainon_list (append_args,
gfc_build_addr_expr (NULL_TREE,
gemm_fndecl));
append_args = VEC_alloc (tree, gc, 3);
VEC_quick_push (tree, append_args, build_int_cst (cint, 1));
VEC_quick_push (tree, append_args,
build_int_cst (cint, gfc_option.blas_matmul_limit));
VEC_quick_push (tree, append_args,
gfc_build_addr_expr (NULL_TREE, gemm_fndecl));
}
else
{
append_args = gfc_chainon_list (NULL_TREE, build_int_cst (cint, 0));
append_args = gfc_chainon_list (append_args, build_int_cst (cint, 0));
append_args = gfc_chainon_list (append_args, null_pointer_node);
append_args = VEC_alloc (tree, gc, 3);
VEC_quick_push (tree, append_args, build_int_cst (cint, 0));
VEC_quick_push (tree, append_args, build_int_cst (cint, 0));
VEC_quick_push (tree, append_args, null_pointer_node);
}
}
......@@ -3285,7 +3285,7 @@ conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr,
unsigned cur_pos;
gfc_actual_arglist* arg;
gfc_symbol* sym;
tree append_args;
VEC(tree,gc) *append_args;
/* Find the two arguments given as position. */
cur_pos = 0;
......@@ -3309,13 +3309,14 @@ conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr,
/* If we do have type CHARACTER and the optional argument is really absent,
append a dummy 0 as string length. */
append_args = NULL_TREE;
append_args = NULL;
if (prim_arg->expr->ts.type == BT_CHARACTER && !opt_arg->expr)
{
tree dummy;
dummy = build_int_cst (gfc_charlen_type_node, 0);
append_args = gfc_chainon_list (append_args, dummy);
append_args = VEC_alloc (tree, gc, 1);
VEC_quick_push (tree, append_args, dummy);
}
/* Build the call itself. */
......
gcc/fortran/trans-stmt.c
......@@ -373,7 +373,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check,
/* Translate the call. */
has_alternate_specifier
= gfc_conv_procedure_call (&se, code->resolved_sym, code->ext.actual,
code->expr1, NULL_TREE);
code->expr1, NULL);
/* A subroutine without side-effect, by definition, does nothing! */
TREE_SIDE_EFFECTS (se.expr) = 1;
......@@ -457,8 +457,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check,
/* Add the subroutine call to the block. */
gfc_conv_procedure_call (&loopse, code->resolved_sym,
code->ext.actual, code->expr1,
NULL_TREE);
code->ext.actual, code->expr1, NULL);
if (mask && count1)
{
......
gcc/fortran/trans.h
......@@ -314,7 +314,7 @@ int gfc_is_intrinsic_libcall (gfc_expr *);
/* Used to call ordinary functions/subroutines
and procedure pointer components. */
int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *,
gfc_expr *, tree);
gfc_expr *, VEC(tree,gc) *);
void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool);
......
gcc/vec.h
......@@ -259,6 +259,32 @@ along with GCC; see the file COPYING3. If not see
#define VEC_reserve_exact(T,A,V,R) \
(VEC_OP(T,A,reserve_exact)(&(V),R VEC_CHECK_INFO MEM_STAT_INFO))
/* Copy elements with no reallocation
void VEC_T_splice (VEC(T) *dst, VEC(T) *src); // Integer
void VEC_T_splice (VEC(T) *dst, VEC(T) *src); // Pointer
void VEC_T_splice (VEC(T) *dst, VEC(T) *src); // Object
Copy the elements in SRC to the end of DST as if by memcpy. DST and
SRC need not be allocated with the same mechanism, although they most
often will be. DST is assumed to have sufficient headroom
available. */
#define VEC_splice(T,DST,SRC) \
(VEC_OP(T,base,splice)(VEC_BASE(DST), VEC_BASE(SRC) VEC_CHECK_INFO))
/* Copy elements with reallocation
void VEC_T_safe_splice (VEC(T,A) *&dst, VEC(T) *src); // Integer
void VEC_T_safe_splice (VEC(T,A) *&dst, VEC(T) *src); // Pointer
void VEC_T_safe_splice (VEC(T,A) *&dst, VEC(T) *src); // Object
Copy the elements in SRC to the end of DST as if by memcpy. DST and
SRC need not be allocated with the same mechanism, although they most
often will be. DST need not have sufficient headroom and will be
reallocated if needed. */
#define VEC_safe_splice(T,A,DST,SRC) \
(VEC_OP(T,A,safe_splice)(&(DST), VEC_BASE(SRC) VEC_CHECK_INFO MEM_STAT_INFO))
/* Push object with no reallocation
T *VEC_T_quick_push (VEC(T) *v, T obj); // Integer
T *VEC_T_quick_push (VEC(T) *v, T obj); // Pointer
......@@ -589,6 +615,19 @@ static inline int VEC_OP (T,base,space) \
return vec_ ? vec_->alloc - vec_->num >= (unsigned)alloc_ : !alloc_; \
} \
\
static inline void VEC_OP(T,base,splice) \
(VEC(T,base) *dst_, VEC(T,base) *src_ VEC_CHECK_DECL) \
{ \
if (src_) \
{ \
unsigned len_ = src_->num; \
VEC_ASSERT (dst_->num + len_ <= dst_->alloc, "splice", T, base); \
\
memcpy (&dst_->vec[dst_->num], &src_->vec[0], len_ * sizeof (T)); \
dst_->num += len_; \
} \
} \
\
static inline T *VEC_OP (T,base,quick_push) \
(VEC(T,base) *vec_, T obj_ VEC_CHECK_DECL) \
{ \
......@@ -796,6 +835,19 @@ static inline void VEC_OP (T,A,safe_grow_cleared) \
sizeof (T) * (size_ - oldsize)); \
} \
\
static inline void VEC_OP(T,A,safe_splice) \
(VEC(T,A) **dst_, VEC(T,base) *src_ VEC_CHECK_DECL MEM_STAT_DECL) \
{ \
if (src_) \
{ \
VEC_OP (T,A,reserve_exact) (dst_, src_->num \
VEC_CHECK_PASS MEM_STAT_INFO); \
\
VEC_OP (T,base,splice) (VEC_BASE (*dst_), src_ \
VEC_CHECK_PASS); \
} \
} \
\
static inline T *VEC_OP (T,A,safe_push) \
(VEC(T,A) **vec_, T obj_ VEC_CHECK_DECL MEM_STAT_DECL) \
{ \
......@@ -881,6 +933,19 @@ static inline int VEC_OP (T,base,space) \
return vec_ ? vec_->alloc - vec_->num >= (unsigned)alloc_ : !alloc_; \
} \
\
static inline void VEC_OP(T,base,splice) \
(VEC(T,base) *dst_, VEC(T,base) *src_ VEC_CHECK_DECL) \
{ \
if (src_) \
{ \
unsigned len_ = src_->num; \
VEC_ASSERT (dst_->num + len_ <= dst_->alloc, "splice", T, base); \
\
memcpy (&dst_->vec[dst_->num], &src_->vec[0], len_ * sizeof (T)); \
dst_->num += len_; \
} \
} \
\
static inline T *VEC_OP (T,base,quick_push) \
(VEC(T,base) *vec_, const T *obj_ VEC_CHECK_DECL) \
{ \
......@@ -1084,6 +1149,19 @@ static inline void VEC_OP (T,A,safe_grow_cleared) \
sizeof (T) * (size_ - oldsize)); \
} \
\
static inline void VEC_OP(T,A,safe_splice) \
(VEC(T,A) **dst_, VEC(T,base) *src_ VEC_CHECK_DECL MEM_STAT_DECL) \
{ \
if (src_) \
{ \
VEC_OP (T,A,reserve_exact) (dst_, src_->num \
VEC_CHECK_PASS MEM_STAT_INFO); \
\
VEC_OP (T,base,splice) (VEC_BASE (*dst_), src_ \
VEC_CHECK_PASS); \
} \
} \
\
static inline T *VEC_OP (T,A,safe_push) \
(VEC(T,A) **vec_, const T *obj_ VEC_CHECK_DECL MEM_STAT_DECL) \
{ \
......@@ -1188,6 +1266,19 @@ static inline void VEC_OP (T,A,safe_grow_cleared) \
sizeof (T) * (size_ - oldsize)); \
} \
\
static inline void VEC_OP(T,A,safe_splice) \
(VEC(T,A) **dst_, VEC(T,base) *src_ VEC_CHECK_DECL MEM_STAT_DECL) \
{ \
if (src_) \
{ \
VEC_OP (T,A,reserve_exact) (dst_, src_->num \
VEC_CHECK_PASS MEM_STAT_INFO); \
\
VEC_OP (T,base,splice) (VEC_BASE (*dst_), src_ \
VEC_CHECK_PASS); \
} \
} \
\
static inline T *VEC_OP (T,A,safe_push) \
(VEC(T,A) **vec_, const T obj_ VEC_CHECK_DECL MEM_STAT_DECL) \
{ \
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment