This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] PATCH: untested CALL_EXPR updates
- From: Sandra Loosemore <sandra at codesourcery dot com>
- To: GCC Patches <gcc-patches at gcc dot gnu dot org>
- Cc: Richard Guenther <richard dot guenther at gmail dot com>, kenner at vlsi1 dot ultra dot nyu dot edu, ebotcazou at adacore dot com
- Date: Fri, 16 Feb 2007 10:18:16 -0500
- Subject: [Ada] PATCH: untested CALL_EXPR updates
Argh!! it might help if I attached the patch before pushing the "send" button!
:-P
Here's a quick patch I put together to update the Ada front end for the
CALL_EXPR changes. This has not been tested in any way.
If anybody would like to put a little more time into this, I suggest rewriting
the bit of code in call_to_gnu that assembles a temporary argument list to pass
to build_call_list to use an alloca'ed array as instead as temporary storage
(see how I did that in max_size farther down). A quick glance at this code
didn't tell me how to determine in advance how many arguments were being passed
and hence how big of an array to allocate, but it'll probably be easy for
somebody already familiar with the Ada-specific data structures. Anyway, the
obvious hack I applied ought to work, albeit not as efficiently as we'd like. :-)
-Sandra
2007-02-16 Sandra Loosemore <sandra@codesourcery.com>
* trans.c (call_to_gnu): Use build_call_list instead of build3 to
build CALL_EXPR.
* utils.c (max_size): Remove case for TREE_LIST. Move CALL_EXPR
handling to a new clause for tcc_exceptional, and walk the arguments
explicitly instead of as a list. Use build_call_array instead
of build3 to construct the new CALL_EXPR.
(build_global_cdtor): Use build_call_nary instead of build3.
* utils2.c (build_call_1_expr): Use build_call_nary instead of build3.
(build_call_2_expr): Likewise.
(build_call_0_expr): Likewise.
(build_call_alloc_dealloc): Likewise.
Index: trans.c
===================================================================
*** trans.c (revision 122017)
--- trans.c (working copy)
*************** call_to_gnu (Node_Id gnat_node, tree *gn
*** 1992,2000 ****
gnu_actual_list = tree_cons (NULL_TREE, gnu_actual, gnu_actual_list);
}
! gnu_subprog_call = build3 (CALL_EXPR, TREE_TYPE (gnu_subprog_type),
! gnu_subprog_addr, nreverse (gnu_actual_list),
! NULL_TREE);
/* If we return by passing a target, we emit the call and return the target
as our result. */
--- 1992,2001 ----
gnu_actual_list = tree_cons (NULL_TREE, gnu_actual, gnu_actual_list);
}
! /* FIXME: rewrite above code not to construct a temporary list. */
! gnu_subprog_call = build_call_list (TREE_TYPE (gnu_subprog_type),
! gnu_subprog_addr,
! nreverse (gnu_actual_list));
/* If we return by passing a target, we emit the call and return the target
as our result. */
Index: utils.c
===================================================================
*** utils.c (revision 122017)
--- utils.c (working copy)
*************** max_size (tree exp, bool max_p)
*** 2335,2348 ****
case tcc_constant:
return exp;
- case tcc_exceptional:
- if (code == TREE_LIST)
- return tree_cons (TREE_PURPOSE (exp),
- max_size (TREE_VALUE (exp), max_p),
- TREE_CHAIN (exp)
- ? max_size (TREE_CHAIN (exp), max_p) : NULL_TREE);
- break;
-
case tcc_reference:
/* If this contains a PLACEHOLDER_EXPR, it is the thing we want to
modify. Otherwise, we treat it like a variable. */
--- 2335,2340 ----
*************** max_size (tree exp, bool max_p)
*** 2428,2437 ****
return fold (build2 (max_p ? MAX_EXPR : MIN_EXPR, type,
max_size (TREE_OPERAND (exp, 1), max_p),
max_size (TREE_OPERAND (exp, 2), max_p)));
- else if (code == CALL_EXPR && TREE_OPERAND (exp, 1))
- return build3 (CALL_EXPR, type, TREE_OPERAND (exp, 0),
- max_size (TREE_OPERAND (exp, 1), max_p), NULL);
}
/* Other tree classes cannot happen. */
default:
--- 2420,2440 ----
return fold (build2 (max_p ? MAX_EXPR : MIN_EXPR, type,
max_size (TREE_OPERAND (exp, 1), max_p),
max_size (TREE_OPERAND (exp, 2), max_p)));
}
+ break;
+
+ case tcc_vl_exp:
+ if (code == CALL_EXPR && call_expr_nargs (exp) > 0)
+ {
+ int n = call_expr_nargs (exp);
+ int i;
+ tree *argarray = (tree *) alloca (n * sizeof (tree));
+
+ for (i = 0; i < n; i++)
+ argarray[i] = max_size (CALL_EXPR_ARG (exp, i), max_p);
+ return build_call_array (type, CALL_EXPR_FN (exp), n, argarray);
+ }
+ break;
/* Other tree classes cannot happen. */
default:
*************** build_global_cdtor (int method_type, tre
*** 3745,3752 ****
{
tree fntype = TREE_TYPE (vec[i]);
tree fnaddr = build1 (ADDR_EXPR, build_pointer_type (fntype), vec[i]);
! tree fncall = build3 (CALL_EXPR, TREE_TYPE (fntype), fnaddr, NULL_TREE,
! NULL_TREE);
append_to_statement_list (fncall, &body);
}
--- 3748,3754 ----
{
tree fntype = TREE_TYPE (vec[i]);
tree fnaddr = build1 (ADDR_EXPR, build_pointer_type (fntype), vec[i]);
! tree fncall = build_call_nary (TREE_TYPE (fntype), fnaddr, 0);
append_to_statement_list (fncall, &body);
}
Index: utils2.c
===================================================================
*** utils2.c (revision 122017)
--- utils2.c (working copy)
*************** build_return_expr (tree result_decl, tre
*** 1394,1404 ****
tree
build_call_1_expr (tree fundecl, tree arg)
{
! tree call = build3 (CALL_EXPR, TREE_TYPE (TREE_TYPE (fundecl)),
! build_unary_op (ADDR_EXPR, NULL_TREE, fundecl),
! chainon (NULL_TREE, build_tree_list (NULL_TREE, arg)),
! NULL_TREE);
!
TREE_SIDE_EFFECTS (call) = 1;
return call;
--- 1394,1402 ----
tree
build_call_1_expr (tree fundecl, tree arg)
{
! tree call = build_call_nary (TREE_TYPE (TREE_TYPE (fundecl)),
! build_unary_op (ADDR_EXPR, NULL_TREE, fundecl),
! 1, arg);
TREE_SIDE_EFFECTS (call) = 1;
return call;
*************** build_call_1_expr (tree fundecl, tree ar
*** 1410,1422 ****
tree
build_call_2_expr (tree fundecl, tree arg1, tree arg2)
{
! tree call = build3 (CALL_EXPR, TREE_TYPE (TREE_TYPE (fundecl)),
! build_unary_op (ADDR_EXPR, NULL_TREE, fundecl),
! chainon (chainon (NULL_TREE,
! build_tree_list (NULL_TREE, arg1)),
! build_tree_list (NULL_TREE, arg2)),
! NULL_TREE);
!
TREE_SIDE_EFFECTS (call) = 1;
return call;
--- 1408,1416 ----
tree
build_call_2_expr (tree fundecl, tree arg1, tree arg2)
{
! tree call = build_call_nary (TREE_TYPE (TREE_TYPE (fundecl)),
! build_unary_op (ADDR_EXPR, NULL_TREE, fundecl),
! 2, arg1, arg2);
TREE_SIDE_EFFECTS (call) = 1;
return call;
*************** build_call_2_expr (tree fundecl, tree ar
*** 1427,1438 ****
tree
build_call_0_expr (tree fundecl)
{
! tree call = build3 (CALL_EXPR, TREE_TYPE (TREE_TYPE (fundecl)),
! build_unary_op (ADDR_EXPR, NULL_TREE, fundecl),
! NULL_TREE, NULL_TREE);
!
! /* We rely on build3 to compute TREE_SIDE_EFFECTS. This makes it possible
! to propagate the DECL_IS_PURE flag on parameterless functions. */
return call;
}
--- 1421,1433 ----
tree
build_call_0_expr (tree fundecl)
{
! tree call = build_call_nary (TREE_TYPE (TREE_TYPE (fundecl)),
! build_unary_op (ADDR_EXPR, NULL_TREE, fundecl),
! 0);
!
! /* We rely on build_call_nary to compute TREE_SIDE_EFFECTS. This makes
! it possible to propagate the DECL_IS_PURE flag on parameterless
! functions. */
return call;
}
*************** build_call_alloc_dealloc (tree gnu_obj,
*** 1721,1750 ****
tree gnu_proc_addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_proc);
tree gnu_pool = gnat_to_gnu (gnat_pool);
tree gnu_pool_addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_pool);
- tree gnu_args = NULL_TREE;
tree gnu_call;
/* The first arg is always the address of the storage pool; next
comes the address of the object, for a deallocator, then the
size and alignment. */
- gnu_args
- = chainon (gnu_args, build_tree_list (NULL_TREE, gnu_pool_addr));
-
if (gnu_obj)
! gnu_args
! = chainon (gnu_args, build_tree_list (NULL_TREE, gnu_obj));
!
! gnu_args
! = chainon (gnu_args,
! build_tree_list (NULL_TREE,
! convert (gnu_size_type, gnu_size)));
! gnu_args
! = chainon (gnu_args,
! build_tree_list (NULL_TREE,
! convert (gnu_size_type, gnu_align)));
!
! gnu_call = build3 (CALL_EXPR, TREE_TYPE (TREE_TYPE (gnu_proc)),
! gnu_proc_addr, gnu_args, NULL_TREE);
TREE_SIDE_EFFECTS (gnu_call) = 1;
return gnu_call;
}
--- 1716,1739 ----
tree gnu_proc_addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_proc);
tree gnu_pool = gnat_to_gnu (gnat_pool);
tree gnu_pool_addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_pool);
tree gnu_call;
/* The first arg is always the address of the storage pool; next
comes the address of the object, for a deallocator, then the
size and alignment. */
if (gnu_obj)
! gnu_call = build_call_nary (TREE_TYPE (TREE_TYPE (gnu_proc)),
! gnu_proc_addr, 4,
! gnu_pool_addr,
! gnu_obj,
! gnu_size,
! gnu_align);
! else
! gnu_call = build_call_nary (TREE_TYPE (TREE_TYPE (gnu_proc)),
! gnu_proc_addr, 3,
! gnu_pool_addr,
! gnu_size,
! gnu_align);
TREE_SIDE_EFFECTS (gnu_call) = 1;
return gnu_call;
}
*************** build_call_alloc_dealloc (tree gnu_obj,
*** 1758,1779 ****
tree gnu_size_type = gnat_to_gnu_type (gnat_size_type);
tree gnu_proc = gnat_to_gnu (gnat_proc);
tree gnu_proc_addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_proc);
- tree gnu_args = NULL_TREE;
tree gnu_call;
/* The first arg is the address of the object, for a
deallocator, then the size */
if (gnu_obj)
! gnu_args
! = chainon (gnu_args, build_tree_list (NULL_TREE, gnu_obj));
!
! gnu_args
! = chainon (gnu_args,
! build_tree_list (NULL_TREE,
! convert (gnu_size_type, gnu_size)));
!
! gnu_call = build3 (CALL_EXPR, TREE_TYPE (TREE_TYPE (gnu_proc)),
! gnu_proc_addr, gnu_args, NULL_TREE);
TREE_SIDE_EFFECTS (gnu_call) = 1;
return gnu_call;
}
--- 1747,1763 ----
tree gnu_size_type = gnat_to_gnu_type (gnat_size_type);
tree gnu_proc = gnat_to_gnu (gnat_proc);
tree gnu_proc_addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_proc);
tree gnu_call;
/* The first arg is the address of the object, for a
deallocator, then the size */
+ gnu_size = convert (gnu_size_type, gnu_size);
if (gnu_obj)
! gnu_call = build_call_nary (TREE_TYPE (TREE_TYPE (gnu_proc)),
! gnu_proc_addr, 2, gnu_obj, gnu_size);
! else
! gnu_call = build_call_nary (TREE_TYPE (TREE_TYPE (gnu_proc)),
! gnu_proc_addr, 1, gnu_size);
TREE_SIDE_EFFECTS (gnu_call) = 1;
return gnu_call;
}