MatCat.OpenSource/8sa1-gcc
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

com.c (ffecom_expr_): Only use TREE_TYPE argument for simple arithmetic...

Browse Source 
* com.c (ffecom_expr_): Only use TREE_TYPE argument for simple
        arithmetic; convert types as necessary; recurse with target tree type.

CVS _----------------------------------------------------------------------

From-SVN: r16287
This commit is contained in:
Richard Henderson 1997-11-02 18:49:29 -08:00 committed by Jeff Law
parent cbd44549e6
commit af75269882
2 changed files with 67 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/f/ChangeLog.egcs
View File

@ -1,3 +1,8 @@
Sun Nov 2 19:49:51 1997 Richard Henderson <rth@cygnus.com>
* com.c (ffecom_expr_): Only use TREE_TYPE argument for simple
arithmetic; convert types as necessary; recurse with target tree type.
Wed Oct 22 11:37:41 1997 Richard Henderson <rth@cygnus.com> Wed Oct 22 11:37:41 1997 Richard Henderson <rth@cygnus.com>
* com.c (ffecom_expr_): Take an new arg TREE_TYPE that if non-null * com.c (ffecom_expr_): Take an new arg TREE_TYPE that if non-null

82
gcc/f/com.c
View File

@ -2674,7 +2674,7 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum)
#if FFECOM_targetCURRENT == FFECOM_targetGCC #if FFECOM_targetCURRENT == FFECOM_targetGCC
static tree static tree
ffecom_expr_ (ffebld expr, tree tree_type, tree dest_tree, ffecom_expr_ (ffebld expr, tree tree_type_x, tree dest_tree,
ffebld dest, bool *dest_used, ffebld dest, bool *dest_used,
bool assignp) bool assignp)
{ {
@ -2685,6 +2685,8 @@ ffecom_expr_ (ffebld expr, tree tree_type, tree dest_tree,
ffeinfoKindtype kt; ffeinfoKindtype kt;
tree t; tree t;
tree dt; /* decl_tree for an ffesymbol. */ tree dt; /* decl_tree for an ffesymbol. */
tree tree_type;
tree left, right;
ffesymbol s; ffesymbol s;
enum tree_code code; enum tree_code code;
@ -2695,8 +2697,7 @@ ffecom_expr_ (ffebld expr, tree tree_type, tree dest_tree,
bt = ffeinfo_basictype (ffebld_info (expr)); bt = ffeinfo_basictype (ffebld_info (expr));
kt = ffeinfo_kindtype (ffebld_info (expr)); kt = ffeinfo_kindtype (ffebld_info (expr));
if (!tree_type) tree_type = ffecom_tree_type[bt][kt];
tree_type = ffecom_tree_type[bt][kt];
switch (ffebld_op (expr)) switch (ffebld_op (expr))
{ {
@ -2940,35 +2941,76 @@ ffecom_expr_ (ffebld expr, tree tree_type, tree dest_tree,
} }
case FFEBLD_opUPLUS: case FFEBLD_opUPLUS:
return ffecom_1 (NOP_EXPR, tree_type, ffecom_expr (ffebld_left (expr))); left = ffecom_expr_ (ffebld_left (expr), tree_type_x, NULL, NULL,
NULL, FALSE);
return ffecom_1 (NOP_EXPR, tree_type, left);
case FFEBLD_opPAREN: /* ~~~Make sure Fortran rules respected here */ case FFEBLD_opPAREN: /* ~~~Make sure Fortran rules respected here */
return ffecom_1 (NOP_EXPR, tree_type, ffecom_expr (ffebld_left (expr))); left = ffecom_expr_ (ffebld_left (expr), tree_type_x, NULL, NULL,
NULL, FALSE);
return ffecom_1 (NOP_EXPR, tree_type, left);
case FFEBLD_opUMINUS: case FFEBLD_opUMINUS:
return ffecom_1 (NEGATE_EXPR, tree_type, left = ffecom_expr_ (ffebld_left (expr), tree_type_x, NULL, NULL,
ffecom_expr (ffebld_left (expr))); NULL, FALSE);
if (tree_type_x)
{
tree_type = tree_type_x;
left = convert (tree_type, left);
}
return ffecom_1 (NEGATE_EXPR, tree_type, left);
case FFEBLD_opADD: case FFEBLD_opADD:
return ffecom_2 (PLUS_EXPR, tree_type, left = ffecom_expr_ (ffebld_left (expr), tree_type_x, NULL, NULL,
ffecom_expr (ffebld_left (expr)), NULL, FALSE);
ffecom_expr (ffebld_right (expr))); right = ffecom_expr_ (ffebld_right (expr), tree_type_x, NULL, NULL,
break; NULL, FALSE);
if (tree_type_x)
{
tree_type = tree_type_x;
left = convert (tree_type, left);
right = convert (tree_type, right);
}
return ffecom_2 (PLUS_EXPR, tree_type, left, right);
case FFEBLD_opSUBTRACT: case FFEBLD_opSUBTRACT:
return ffecom_2 (MINUS_EXPR, tree_type, left = ffecom_expr_ (ffebld_left (expr), tree_type_x, NULL, NULL,
ffecom_expr (ffebld_left (expr)), NULL, FALSE);
ffecom_expr (ffebld_right (expr))); right = ffecom_expr_ (ffebld_right (expr), tree_type_x, NULL, NULL,
NULL, FALSE);
if (tree_type_x)
{
tree_type = tree_type_x;
left = convert (tree_type, left);
right = convert (tree_type, right);
}
return ffecom_2 (MINUS_EXPR, tree_type, left, right);
case FFEBLD_opMULTIPLY: case FFEBLD_opMULTIPLY:
return ffecom_2 (MULT_EXPR, tree_type, left = ffecom_expr_ (ffebld_left (expr), tree_type_x, NULL, NULL,
ffecom_expr (ffebld_left (expr)), NULL, FALSE);
ffecom_expr (ffebld_right (expr))); right = ffecom_expr_ (ffebld_right (expr), tree_type_x, NULL, NULL,
NULL, FALSE);
if (tree_type_x)
{
tree_type = tree_type_x;
left = convert (tree_type, left);
right = convert (tree_type, right);
}
return ffecom_2 (MULT_EXPR, tree_type, left, right);
case FFEBLD_opDIVIDE: case FFEBLD_opDIVIDE:
return ffecom_tree_divide_ (tree_type, left = ffecom_expr_ (ffebld_left (expr), tree_type_x, NULL, NULL,
ffecom_expr (ffebld_left (expr)), NULL, FALSE);
ffecom_expr (ffebld_right (expr)), right = ffecom_expr_ (ffebld_right (expr), tree_type_x, NULL, NULL,
NULL, FALSE);
if (tree_type_x)
{
tree_type = tree_type_x;
left = convert (tree_type, left);
right = convert (tree_type, right);
}
return ffecom_tree_divide_ (tree_type, left, right,
dest_tree, dest, dest_used); dest_tree, dest, dest_used);
case FFEBLD_opPOWER: case FFEBLD_opPOWER: