Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed
/*
Crown Copyright (c) 1997
This TenDRA(r) Computer Program is subject to Copyright
owned by the United Kingdom Secretary of State for Defence
acting through the Defence Evaluation and Research Agency
(DERA). It is made available to Recipients with a
royalty-free licence for its use, reproduction, transfer
to other parties and amendment for any purpose not excluding
product development provided that any such use et cetera
shall be deemed to be acceptance of the following conditions:-
(1) Its Recipients shall ensure that this Notice is
reproduced upon any copies or amended versions of it;
(2) Any amended version of it shall be clearly marked to
show both the nature of and the organisation responsible
for the relevant amendment or amendments;
(3) Its onward transfer from a recipient to another
party shall be deemed to be that party's acceptance of
these conditions;
(4) DERA gives no warranty or assurance as to its
quality or suitability for any purpose and DERA accepts
no liability whatsoever in relation to any use to which
it may be put.
*/
/**********************************************************************
$Author: pwe $
$Date: 1998/03/11 11:03:20 $
$Revision: 1.4 $
$Log: check_id.c,v $
* Revision 1.4 1998/03/11 11:03:20 pwe
* DWARF optimisation info
*
* Revision 1.3 1998/02/18 11:22:09 pwe
* test corrections
*
* Revision 1.2 1998/02/11 16:56:38 pwe
* corrections
*
* Revision 1.1.1.1 1998/01/17 15:55:46 release
* First version to be checked into rolling release.
*
* Revision 1.14 1998/01/09 09:28:35 pwe
* prep restructure
*
* Revision 1.13 1997/06/02 08:44:17 currie
* diags visible
*
* Revision 1.12 1997/03/20 17:05:10 currie
* Dwarf2 diags
*
Revision 1.11 1997/02/18 12:56:21 currie
NEW DIAG STRUCTURE
* Revision 1.10 1995/10/19 12:11:23 currie
* compound_tag
*
* Revision 1.9 1995/10/17 16:33:53 currie
* Misplace {
*
* Revision 1.8 1995/10/17 12:59:28 currie
* Power tests + case + diags
*
* Revision 1.7 1995/10/13 15:15:03 currie
* case + long ints on alpha
*
* Revision 1.6 1995/10/06 14:41:55 currie
* Env-offset alignments + new div with ET
*
* Revision 1.5 1995/10/04 09:17:27 currie
* CR95_371 + optimise compounds
*
* Revision 1.4 1995/08/31 14:18:58 currie
* mjg mods
*
* Revision 1.3 1995/08/29 10:45:45 currie
* Various
*
* Revision 1.2 1995/06/15 08:42:07 currie
* make_label + check repbtseq
*
* Revision 1.1 1995/04/06 10:44:05 currie
* Initial revision
*
***********************************************************************/
/********************************************************************
check_id.c
check_id tries to apply transformations to improve identity and
variable declarations.
check_id delivers 1 if it makes any change, 0 otherwise.
used_in delivers 0 if the identifier declared by vardec is unused in
the exp piece, 1 if it is used for contents operation only, 3 if it is
used otherwise.
simple_const tests whether e is used as a simple constant in whole.
This is true in the following circumstances only.
1) e is a constant.
2) e is an identity declaration(not a variable) and the declaration is
external to whole.
3) e is the contents of a variable, and the variable is not used
in whole as the destination of an assignment, and the variable
is only used (anywhere) as the destination of assignment or
argument of contents (ie there is no alias for it).
no_ass is true iff there are no assignments to things that might
be aliased during the evaluation of whole. (beware procedure calls!)
********************************************************************/
#include "config.h"
#include "common_types.h"
#include "exp.h"
#include "expmacs.h"
#include "shapemacs.h"
#include "check.h"
#include "tags.h"
#include "externs.h"
#include "installglob.h"
#include "flags.h"
#include "install_fns.h"
#include "me_fns.h"
#ifdef NEWDIAGS
#include "dg_aux.h"
#endif
#include "check_id.h"
#if is68000
extern int check_anyway PROTO_S ( ( exp ) ) ;
#endif
/* PROCEDURES */
/*********************************************************************
make_onearg makes up an exp with the given tag (n), shape (sha)
and single argument (a).
*********************************************************************/
exp hc
PROTO_N ( (e, t) )
PROTO_T ( exp e X exp t )
{
setlast(t);
bro(t) = e;
return hold_check(e);
}
static exp make_onearg
PROTO_N ( (n, sha, a) )
PROTO_T ( unsigned char n X shape sha X exp a )
{
exp r = getexp (sha, nilexp, 0, a, nilexp, 0, 0, n);
return (hc (r, a));
}
/*********************************************************************
make_twoarg makes up an exp with the given tag (n), shape (sha)
and two arguments (a,b) in that order.
*********************************************************************/
static exp make_twoarg
PROTO_N ( (n, sha, a, b) )
PROTO_T ( unsigned char n X shape sha X exp a X exp b )
{
exp r = getexp (sha, nilexp, 0, a, nilexp, 0, 0, n);
bro (a) = b;
clearlast (a);
return (hc (r, b));
}
/************************************************************************
used_in delivers 0 if the identifier declared by vardec is unused in
the exp piece, 1 if it is used for contents operation only, 3 if it is
used otherwise.
************************************************************************/
int used_in
PROTO_N ( (vardec, piece) )
PROTO_T ( exp vardec X exp piece )
{
int res = 0;
exp t = pt (vardec);
exp q;
exp upwards = t;
do { /* test each use of the identifier */
q = t;
while (q != nilexp && q != piece && q != vardec && !parked(q) &&
(name (q) != ident_tag || !isglob(q))) {
upwards = q;
q = bro (q);
};
/* ascend from the use until we reach either vardec or piece */
if (last (upwards) && q == piece) {/* the use was in piece */
res = 1;
if ((last(t) || !last(bro(t)) || name(bro(bro(t))) != 0)) {
if (!last(t) ||
name(bro(t)) != cont_tag)
res = 3; /* the use was not contents or in diagnostics*/
};
};
t = pt (t);
}
while (t != nilexp && res != 3);
return (res);
}
/***********************************************************************
simple_const tests whether e is used as a simple constant in whole.
This is true in the following circumstances only.
1) e is a constant.
2) e is an identity declaration(not a variable) and the declaration is
external to whole.
3) e is the contents of a variable, and the variable is not used
in whole as the destination of an assignment, and the variable
is only used (anywhere) as the destination of assignment or
argument of contents (ie there is no alias for it).
no_ass is true iff there are no assignements to things that might
be aliased during the evaluation of whole. (ware procedure calls!)
***********************************************************************/
int simple_const
PROTO_N ( (whole, e, decl, no_ass) )
PROTO_T ( exp whole X exp e X int decl X int no_ass )
{
if (name (e) == val_tag || name (e) == real_tag || name (e) == null_tag)
return (1);
if (name (e) == name_tag && !isvar (son (e)) &&
(decl || !internal_to (whole, son (e))))
return (1);
if (name (e) == reff_tag)
e = son (e);
if (name (e) == cont_tag && name (son (e)) == name_tag &&
!isparam (son (son (e))) &&
isvar (son (son (e)))) {
exp var = son (son (e));
int u = used_in (var, whole);
if (u != 3 && (iscaonly(var) || no_ass))
return (1);
return (0);
};
return (0);
}
/* replace declaration by sequence of
definition and body. Done if the
identifier is not used. */
static void repbyseq
PROTO_N ( (e) )
PROTO_T ( exp e )
{
exp def = son (e);
exp body = hold_check(bro (def));
exp seq, s;
#ifdef NEWDIAGS
exp t = pt (e);
while (t != nilexp) {
if (isdiaginfo(t))
setdiscarded(t);
t = pt(t);
}
#endif
if (son (def) == nilexp) {
#ifdef NEWDIAGS
if (diagnose)
dg_whole_comp (e, body);
#endif
replace (e, body, e);
retcell (def);
return;
};
seq = getexp (f_bottom, nilexp, 0, def, nilexp, 0, 0, 0);
bro (def) = seq;
setlast (def);
s = hold_check(make_twoarg (seq_tag, sh (body), seq, body));
#ifdef NEWDIAGS
if (diagnose)
dg_whole_comp (e, s);
#endif
replace (e, s, e);
return;
}
/************************************************************************
propagate looks right and upwards from plc through the tree, looking
for contents operations applied to the variable defined by vardec.
The assumption is that plc made an assignment to the variable defined
by vardec, and this scan looks forward from this point, marking any
contents operations on that variable for later modification to use the
value assigned. The variable is previously checked to make
sure there is no alias for it.
The scan terminates if ende is reached or when it is no longer safe
to propagate the value forward. 1 is delivered if ende was reached
while propagation was still safe, 0 otherwise.
************************************************************************/
static int propagate
PROTO_N ( (vardec, ende, plc, bfirst) )
PROTO_T ( exp vardec X exp ende X exp plc X int bfirst )
{
exp p = plc; /* starting place */
int good = 1; /* good is set to 0 when we find a place
where we must stop */
int bb = bfirst; /* if bb is 1, avoid the first up */
/* up ascends the tree */
up: if (bb)
bb = 0;
else {
if (p == ende) { /* finished */
goto ex;
}
else {
if (!last (p)) {
p = bro (p);
if (name (p) == labst_tag) {/* can't go further */
good = 0;
goto ex;
};
}
else {
if (name (bro (p)) == proc_tag ||
name (bro (p)) == labst_tag ||
name (bro (p)) == condassign_tag) {
/* can't go further */
good = 0;
goto ex;
}
else {
p = bro(p);
if ((name (p) == ass_tag || name (p) == assvol_tag) &&
name (son (p)) == name_tag && son (son (p)) == vardec) {
good = 0;
goto ex;
};
goto up;
};
}
};
};
/* rep processes an exp */
rep: if (name (p) == ass_tag || name (p) == assvol_tag) {
if (name (son (p)) == name_tag && son (son (p)) == vardec) {
/* just process the value */
p = bro(son(p));
goto rep;
}
else { /* assignment to something else */
p = son (p);
goto rep;
};
};
if (name (p) == cont_tag) {
if (name (son (p)) == name_tag && son (son (p)) == vardec) {
set_propagate(p); /* mark it */
goto up;
}
else {
p = son (p);
goto rep;
};
};
if (name (p) == name_tag || name(p) == env_offset_tag)
goto up;
if (name (p) == apply_tag || name(p) == apply_general_tag) {
if (isglob(vardec)) {/* vardec is global */
good = 0;
goto ex;
}
else { /* not aliased so OK */
p = son (p);
goto rep;
};
};
if (name (p) == rep_tag) {
good = 0;
goto ex;
};
if (name (p) == cond_tag) {
if (propagate (vardec, son (p), son (p), 1)) {
good = propagate (vardec, bro(son(bro (son (p)))),
bro(son(bro (son (p)))), 1);
/* if we can propagate right through the first of the cond we can go
into the alt. This condition is stronger than needed. */
if (good)
goto up;
else
goto ex;
}
else {
good = 0;
goto ex;
};
};
if (name (p) == solve_tag) {
IGNORE propagate (vardec, son (p), son (p), 1);
/* give up after trying the first element */
good = 0;
goto ex;
};
if (name (p) == case_tag) {
if (propagate (vardec, son (p), son (p), 1))
goto up;
good = 0;
goto ex;
};
if (son (p) == nilexp)
goto up;
p = son (p);
goto rep;
ex: return (good);
}
/*******************************************************************
change_cont looks at all the cont uses of the variable defined by
vardec. If they have been marked by propagate or if force is 1,
the cont(var) is replaced by val.
*******************************************************************/
static exp change_shape
PROTO_N ( (e, sha) )
PROTO_T ( exp e X shape sha )
{
if (name (e) == val_tag)
no (e) = dochvar (no (e), sha);
sh (e) = sha;
return (e);
}
static int change_cont
PROTO_N ( (vardec, val, force) )
PROTO_T ( exp vardec X exp val X int force )
{
exp t;
exp bh = hold (bro (son (vardec)));
int ch = 0;
int go = 1;
int defsize = shape_size(sh(son(vardec)));
while (go) {
t = pt (vardec);
go = 0;
while (!go && t != nilexp) {
if (last (t) && name (bro (t)) == cont_tag &&
#ifdef NEWDIAGS
!isdiaginfo(t) &&
#endif
(to_propagate (bro (t)) || force)) {
if (defsize == shape_size(sh(bro(t)))) {
exp p = bro (t);
exp c = change_shape (copy (val), sh (p));
kill_exp (t, son(bh));
replace (p, c, son(bh));
retcell (p);
t = pt (vardec);
ch = 1;
go = 1;
}
else
clear_propagate(bro(t));
}
else
t = pt (t);
};
};
bro (son (vardec)) = son (bh);
setlast (bro (son (vardec)));
bro (bro (son (vardec))) = vardec;
retcell (bh);
return (ch);
}
/*********************************************************************
checks identity and variable declarations.
*********************************************************************/
int check_id
PROTO_N ( (e, scope) )
PROTO_T ( exp e X exp scope )
{
int is_var = isvar (e);
int is_vis = (all_variables_visible || isvis (e));
exp def = son (e);
exp body = bro (def);
int looping;
exp t1;
if ( no (e) == 0 )
{
if (!isvis(e) && !isenvoff(e) && !isglob (e) && !isparam(e)) {
/* the variable is not used */
repbyseq (e);
return (1);
}
else
{
if (isparam(e))
setcaonly(e);
return 0;
};
};
#if load_ptr_pars
if (!is_vis && is_var && isparam(e) && no(e) > 1 &&
name(sh(def)) == ptrhd
#if is68000
&& check_anyway(e)
#endif
) {
int ch_load = 1;
int sz = shape_size(sh(def));
t1 = pt (e);
looping = 1;
do {
#ifdef NEWDIAGS
if (!isdiaginfo(t1)) {
#endif
if (!last (t1) && last (bro (t1)) &&
name (bro (bro (t1))) == ass_tag &&
shape_size(sh(bro(t1))) == sz) {
;
}
else
if (!last (t1) || name (bro (t1)) != cont_tag ||
shape_size(sh(bro(t1))) != sz)
ch_load = 0;
#ifdef NEWDIAGS
};
#endif
if (pt (t1) == nilexp)
looping = 0;
else
t1 = pt (t1);
}
while (looping && ch_load);
if (ch_load) {
exp old_pt_list = pt(e);
int old_uses = no(e);
exp new_var;
exp new_n;
exp real_body;
t1 = e;
while (name(bro(son(t1))) == ident_tag && isparam(bro(son(t1))))
t1 = bro(son(t1));
real_body = bro(son(t1));
new_n = getexp(sh(def), real_body, 0, e, nilexp, 0,
0, name_tag);
new_var = getexp(sh(e), nilexp, 0, new_n, old_pt_list,
1, old_uses, ident_tag);
setloadparam(new_n);
setfather(new_var, real_body);
pt(e) = new_n;
no(e) = 1;
clearvar(e);
while (old_pt_list != nilexp)
{
son(old_pt_list) = new_var;
old_pt_list = pt(old_pt_list);
};
new_var = hold_check(new_var);
bro(son(t1)) = new_var;
setfather(t1, new_var);
return 1;
};
};
#endif
if (!is_vis && !is_var &&
#if load_ptr_pars
(name(def) != name_tag || !isloadparam(def)) &&
#endif
(name (def) == val_tag ||
#if load_ptr_pars
(name (def) == name_tag &&
(!isparam(son(def)) || name(sh(def)) == ptrhd))
#else
name (def) == name_tag
#endif
||
#if is80x86
(name(def) == name_tag && isparam(son(def)) && !isvar(son(def)) &&
shape_size(sh(def)) < shape_size(sh(son(son(def)))) &&
name(sh(def)) <= ulonghd) ||
#endif
( /* substitute the definitions of identity declarations into
body if it seems cheaper to do so */
name (def) == reff_tag && name (son (def)) == cont_tag &&
name (son (son (def))) == name_tag &&
isvar (son (son (son (def)))) &&
!isglob (son (son (son (def)))) &&
used_in(son (son (son (def))), body) != 3
) ||
(
name (def) == reff_tag && name (son (def)) == name_tag &&
isvar (son (son (def))) &&
!isglob (son (son (def))) &&
used_in(son (son (def)), body) != 3
) ||
name (def) == null_tag ||
name (def) == real_tag)) {
/* identifying a constant or named value */
{
#if !substitute_params
int do_anyway = 0;
#else
int do_anyway = 1;
#endif
if (do_anyway || name (def) != name_tag ||
!isparam (son (def)) ||
isvar (son (def))) {
exp bh = hold (body);
#ifdef NEWDIAGS
dg_info dgh = dgf(def);
dgf(def) = nildiag; /* don't copy line info to all uses */
#endif
while (pt (e) != nilexp) {
exp mem = pt (e);
exp cp;
pt (e) = pt (mem);
cp = copy (def);
#ifdef NEWDIAGS
if (isdiaginfo(mem))
IGNORE diaginfo_exp (cp);
else
--no (e);
#else
--no (e);
#endif
if (name (cp) == name_tag)
no (cp) += no (mem);
if (sh(cp) != sh(mem)) {
if (name(sh(cp)) <= u64hd)
cp = hold_check(me_u3(sh(mem), cp, chvar_tag));
else
sh (cp) = sh (mem);
};
#ifdef NEWDIAGS
if (diagnose)
dg_whole_comp (mem, cp);
#endif
replace (mem, cp, body);
};
#ifdef NEWDIAGS
dgf(def) = dgh;
#endif
bro (def) = son (bh);
bro (bro (def)) = e;
setlast (bro (def));
retcell (bh);
IGNORE check (e, scope);
return (1);
};
};
};
if (!is_vis && !is_var &&
name(def) == reff_tag && al1(sh(def)) == 1
) { /* also substitute identity definitions which are references
to bitfields. */
exp t = pt(e);
int n = no(def);
shape sha = sh(def);
shape shb = sh(son(def));
exp q, k;
#ifdef NEWDIAGS
if (diagnose)
dg_whole_comp (def, son(def));
#endif
replace(def, son(def), son(def));
while (1)
{
k = pt(t);
q = getexp(sha, nilexp, 0, copy(t), nilexp, 0, n, reff_tag);
sh(son(q)) = shb;
q = hc(q, son(q));
replace(t, q, q);
kill_exp(t, t);
if (k == nilexp)
return 1;
t = k;
};
};
if (!is_vis && !is_var && name (def) == string_tag) {
/* and substitute strings */
exp t = pt (e);
int all_chars = 1;
while (1) {
if (name (sh (t)) > ucharhd) {
all_chars = 0;
break;
};
if (last (t)) /* Surely this is wrong ??? */
break;
t = pt (t);
};
if (all_chars) {
char *str = nostr(def);
t = pt (e);
while (1) {
int l = (int)last (t); /* Surely this is wrong ??? */
exp n = bro (t);
int v = str[no (t) / 8];
exp c;
if (name (sh (t)) == ucharhd)
v = v & 0xff;
c = getexp (sh (t), nilexp, 0, nilexp, nilexp, 0, v, val_tag);
replace (t, c, c);
kill_exp (t, t);
if (l)
break;
t = n;
};
if (no (e) == 0) {
replace (e, bro (son (e)), scope);
return (1);
};
return (0);
};
};
if (!is_vis && !is_var &&
name (body) == seq_tag && name (son (son (body))) == ass_tag &&
name (bro (son (body))) == name_tag) {
exp tb = bro (son (son (son (body))));
if (name (tb) == name_tag && son (tb) == e &&
son (bro (son (body))) == e &&
last (son (son (body))) &&
sh (tb) == sh (def) && sh (tb) == sh (bro (son (body)))) {
/* e=id(def, seq(ass(tz, n(e)), n(e)) -> seq(ass(tz, def),
cont(tz)) */
exp ass = son (son (body));
exp tz = son (ass);
exp r, s, c;
exp cz = copy (tz);
bro (tz) = def;
ass = hc (ass, def);
r = getexp (f_top, nilexp, 0, ass, nilexp, 0, 0, 0);
setlast (ass);
bro (ass) = r;
s = getexp (sh (body), nilexp, 0, r, nilexp, 0, 0, seq_tag);
c = getexp (sh (body), s, 1, cz, nilexp, 0, 0, cont_tag);
setbro (r, hc (c, cz));
replace (e, hc (s, bro (son (s))), e);
return (1);
};
};
/* look to see if we can replace variable definitions by identities.
This can be done if there are only contents operations and no
aliasing */
if (!is_vis && is_var) { /* variable declaration */
int all_c = 1; /* every use is a contents operation */
int all_a = 1; /* every use is an assignment operation */
int not_aliased = 1;
int ca = 0; /* there is an assignment of a constant */
int vardecass = 0; /* there is an assignment of a variable
(not its contents) (lhvalue in C
terms). */
exp assd_val; /* the assigned value */
int conversion = 0;
int biggest_assigned_const = 0;
exp tc = pt (e);
int defsize = shape_size(sh(def));
do { /* scan the uses of the variable */
if (last(tc) && (name(bro(tc)) == hold_tag || name(bro(tc))==hold2_tag)){
#ifdef NEWDIAGS
if (diag_visible) {
#else
if (diagnose) {
#endif
setvis(e);
return 0;
}
}
else {
if (last (tc) && name (bro (tc)) == cont_tag && no(tc) == 0 &&
#ifdef NEWDIAGS
!isdiaginfo(tc) &&
#endif
(name(sh(bro(tc)))<shrealhd || name(sh(bro(tc)))>doublehd ||
(name(sh(def)) >= shrealhd && name(sh(def)) <= doublehd) )) {
int qq = shape_size(sh(bro (tc)));
all_a = 0; /* contents op so not all assignments */
if (name(father(bro(tc))) != test_tag)
conversion = -1;
if ((defsize != qq) &&
(name(sh(def)) < shrealhd))
{
#if is80x86
if (!isparam(e) || no(e) != 1) {
if (no(tc) == 0 && defsize <= 32) {
if (qq == 8)
setbyteuse(e);
}
else {
all_c = 0;
not_aliased = 0;
}
}
#else
all_c = 0;
not_aliased = 0;
#endif
};
}
else {
if (!last (tc) && last (bro (tc)) && no(tc) == 0 &&
#ifdef NEWDIAGS
!isdiaginfo(tc) &&
#endif
name (bro (bro (tc))) == ass_tag) {/* assignment op */
all_c = 0; /* not all contents */
assd_val = bro (tc);
if (name(assd_val) == val_tag) {
if (no(assd_val) < 0 )
conversion = -1;
if (no(assd_val) > biggest_assigned_const)
biggest_assigned_const = no(assd_val);
}
else
if (name(assd_val) == chvar_tag &&
name(sh(son(assd_val))) <= uwordhd &&
is_signed(sh(son(assd_val)))) {
int sz1 = shape_size(sh(son(assd_val)));
if (conversion == 0)
conversion = sz1;
else
if (conversion != sz1)
conversion = -1;
}
else
conversion = -1;
if (defsize != shape_size(sh(assd_val)))
{
#if is80x86
if (no(tc) == 0 && defsize <= 32) {
if (shape_size(sh(bro(tc))) == 8)
setbyteuse(e);
}
else {
all_a = 0;
not_aliased = 0;
};
#else
all_a = 0;
not_aliased = 0;
#endif
};
if (name (assd_val) == val_tag || name (assd_val) == real_tag ||
name (assd_val) == null_tag ||
(name (assd_val) == name_tag &&
isglob (son (assd_val))))
ca = 1; /* assigning a constant */
else {
if (name (assd_val) == ident_tag &&
isvar (assd_val))
vardecass = 1;
};
}
else
#ifdef NEWDIAGS
if (!isdiaginfo(tc))
#endif
{
if (isreallyass(tc)) {
all_c = 0;
all_a = 0; /* so that we dont remove the proc call */
}
else { /* something else */
exp dad = father (tc);
all_c = 0;
all_a = 0;
if (!((name (dad) == addptr_tag || name (dad) == subptr_tag) &&
((!last (dad) && last (bro (dad)) &&
name (bro (bro (dad))) == ass_tag) ||
(last (dad) && name (bro (dad)) == cont_tag))) ||
(name (sh (def)) == realhd &&
name (sh (bro (dad))) != realhd) ||
(name (sh (def)) == doublehd &&
name (sh (bro (dad))) != doublehd))
/* not an assignment to element of array */
not_aliased = 0;
else
{
setvis (e);
uses_loc_address = 1;
};
};
}
};
};
tc = pt (tc);
}
while (tc != nilexp);
if (not_aliased || iscaonly(e))
setcaonly (e); /* set no alias flag if nothing but cont
and ass */
else
{
setvis (e); /* set visible flag if there is an alias
*/
uses_loc_address = 1;
};
if (all_c) { /* if only cont operations replace by an
identity declaration and change the
uses accordingly */
exp bh = hold (body);
int i,
j;
setid(e);
tc = e;
do {
tc = pt (tc);
if (name(bro(tc)) == cont_tag) {
sh (tc) = sh (bro (tc));
#ifdef NEWDIAGS
if (diagnose)
dg_whole_comp (bro(tc), tc);
#endif
replace (bro (tc), tc, tc);
};
}
while (pt (tc) != nilexp);
if (no(e) < 100) {
for (i = 0; i < no (e); ++i) {
tc = e;
for (j = 0; tc != nilexp && j <= i; ++j) {
tc = pt (tc);
#ifdef NEWDIAGS
while (tc != nilexp && isdiaginfo(tc))
tc = pt (tc);
#endif
}
altered (tc, son (bh));
};
};
bro (def) = son (bh);
bro (bro (def)) = e;
setlast (bro (def));
retcell (bh);
IGNORE check (e, scope);
return (1);
};
#if is80x86 || ishppa
/* look for places where we can avoid sign extending */
if (not_aliased && name(sh(def)) == slonghd &&
conversion == 16 && /* not 8 because of 80x86 regs */
(biggest_assigned_const &
((conversion == 8) ? (int)0xffffff80 : (int)0xffff8000)) == 0 &&
name(def) == clear_tag) {
exp temp = pt(e);
shape ish = (conversion == 8) ? scharsh : swordsh;
setse_opt(e);
while (temp != nilexp) {
exp next = pt(temp);
if (last(temp)) {
if ((last(bro(temp)) || name(bro(bro(temp))) != val_tag) &&
name(bro(temp)) != hold_tag) {
exp x = me_u3(slongsh, copy(bro(temp)), chvar_tag);
sh(son(x)) = ish;
replace(bro(temp), x, x);
IGNORE check(father(x), father(x));
kill_exp(bro(temp), bro(temp));
};
}
else {
if (name(bro(temp)) == val_tag)
sh(bro(temp)) = ish;
else {
bro(son(bro(temp))) = bro(bro(temp));
bro(temp) = son(bro(temp));
#if ishppa
sh(bro(temp)) = (conversion == 8) ? ucharsh : uwordsh;
#endif
};
};
temp = next;
};
replace(def, me_shint(slongsh, 0), def);
};
#endif
if (not_aliased && no(e) < 1000 &&
(name(sh(def)) < shrealhd || name(sh(def)) > doublehd) &&
(ca || vardecass || name (def) == val_tag ||
name (son (e)) == real_tag || name (def) == null_tag)) {
/* propagate constant assignment forward from the place where they
occur */
int no_ass;
int chv;
if (name (def) == val_tag || name (son (e)) == real_tag ||
name (def) == null_tag
/*
||
(name (def) == name_tag &&
isglob (son (def)))
*/
) {
do {
body = bro (def);
IGNORE propagate (e, e, body, 1);
}
while (change_cont (e, def, 0));
};
body = bro (def);
do {
chv = 0;
no_ass = 0;
tc = pt (e);
while (!chv && tc != nilexp) {
if (!last (tc) &&
#ifdef NEWDIAGS
!isdiaginfo(tc) &&
#endif
sh (bro (tc)) == sh (son (son (tc))) &&
last (bro (tc)) &&
name (bro (bro (tc))) == ass_tag) {
exp var = bro (tc);
exp va, df, bd;
if (eq_shape (sh (bro (tc)), sh (son (e))) &&
(name (bro (tc)) == val_tag ||
name (bro (tc)) == real_tag ||
name (bro (tc)) == null_tag
/*
||
(name (bro (tc)) == name_tag &&
isglob (son (bro (tc))))
*/
)) {
IGNORE propagate (e, e, bro (bro (tc)), 0);
chv = change_cont (e, bro (tc), 0);
body = bro (def);
++no_ass;
}
else {
va = son (tc);
df = son (var);
if (df != nilexp && (bd = bro(df)) != nilexp &&
!isinlined(e) &&
!isglob(va) && isvar(va) &&
name (bd) == seq_tag &&
name (bro (son (bd))) == cont_tag &&
name (son (bro (son (bd)))) == name_tag &&
son (son (bro (son (bd)))) == var &&
isvar (var) &&
used_in (va, bd) == 0) {
exp a = son (bro (var));
exp prev_uses, ass, seq_hold, s;
kill_exp (bro (son (bd)), body);
prev_uses = pt (va);
tc = var;
pt (va) = pt (var);
do {
son (pt (tc)) = va;
++no (va);
tc = pt (tc);
}
while (pt (tc) != nilexp);
pt (tc) = prev_uses;
if (name (df) == clear_tag)
ass = getexp (f_top, nilexp, 0, nilexp, nilexp,
0, 0, top_tag);
else {
ass = getexp (f_top, nilexp, 0, a, nilexp,
0, 0, ass_tag);
bro (a) = df;
bro (df) = ass;
setlast (df);
};
seq_hold = make_onearg (0, f_bottom, ass);
s = make_twoarg (seq_tag, f_top, seq_hold,
son (son (bd)));
replace (bro (var), s, body);
chv = 1;
};
};
};
tc = pt (tc);
};
} while (chv) ;
#ifdef NEWDIAGS
if (no (e) == no_ass && !isparam(e)) {
int diagonly = 1;
tc = pt (e);
while (tc != nilexp) {
if (!isdiaginfo(tc)) {
if (diagnose)
dg_rem_ass (bro(bro(tc)));
replace (bro (bro (tc)), bro (tc), bro(def));
diagonly = 0;
}
tc = pt (tc);
};
if (!diagonly)
repbyseq (e);
};
#else
if (no (e) == no_ass && pt (e) != nilexp && !isparam(e)) {
tc = pt (e);
while (replace (bro (bro (tc)), bro (tc), bro(def)),
pt (tc) != nilexp)
tc = pt (tc);
repbyseq (e);
};
#endif
return (1);
};
if (!isparam(e) && name (def) == clear_tag &&
name (body) == seq_tag &&
name (son (son (body))) == ass_tag &&
name (son (son (son (body)))) == name_tag &&
son (son (son (son (body)))) == e &&
eq_shape (sh (def), sh (bro (son (son (son (body))))))) {
/* definition is clear and first assignment is to this variable */
exp val = bro (son (son (son (body))));/* assigned value */
if (!used_in(e, val)) {
son (e) = val; /* put it in as initialisation */
clearlast (val);
bro (val) = body;
/* kill the use of var */
kill_exp (son (son (son (body))), son (son (son (body))));
replace (son (son (body)),
getexp (f_top, nilexp, 0, nilexp, nilexp, 0, 0, top_tag),
body); /* replace assignment by void */
return (1);
};
};
#ifdef NEWDIAGS
if (all_a && !isparam(e) && !diag_visible) {
#else
if (all_a && !isparam(e) && !diagnose) {
#endif
/* if only assignments replace them by
evaluating the value assigned and
discarding it. replace the declaration
by a sequence of definition and body */
tc = pt (e);
while (1)
{
if (!last(tc) && name(bro(bro(tc))) == ass_tag) {
#ifdef NEWDIAGS
if (diagnose)
dg_rem_ass (bro(bro(tc)));
#endif
replace (bro (bro (tc)), bro (tc), body);
}
tc = pt(tc);
if (tc == nilexp)
break;
};
repbyseq (e);
return (1);
};
};
if (!is_var && !is_vis && no(e) == 1 && !isparam(e) &&
name(body) == ident_tag && name(son(body)) == name_tag &&
son(son(body)) == e &&
shape_size(def) == shape_size(son(body))) {
#ifdef NEWDIAGS
if (diagnose) {
exp t = pt(e);
while (t) {
if (isdiaginfo(t))
setdiscarded(t);
t = pt(t);
}
}
#endif
replace(son(body), def, def);
#ifdef NEWDIAGS
if (diagnose)
dg_whole_comp (e, body);
#endif
replace(e, body, scope);
return 1;
};
if (!is_var && !is_vis && name(def) == compound_tag) {
exp c = son(def);
int nuses = no(e);
int changed = 0;
for(; ; ) {
int n = name(bro(c));
if (n == val_tag || n == real_tag || n == name_tag ||
n == null_tag){
exp u = pt(e);
for(; nuses !=0 && u!=nilexp; ) {
exp nextu = pt(u);
#ifdef NEWDIAGS
if (!isdiaginfo(u) && no(u)==no(c) && eq_shape(sh(u), sh(bro(c))) ) {
#else
if (no(u)==no(c) && eq_shape(sh(u), sh(bro(c))) ) {
#endif
replace(u, copy(bro(c)), bro(def));
nextu = pt(u); /* it could have changed */
kill_exp(u, bro(def));
nuses--;
changed = 1;
}
u = nextu;
}
}
if (nuses ==0 || last(bro(c))) break;
c = bro(bro(c));
}
if ((no(e)==0 || pt(e) == nilexp) && !isenvoff(e) ) {
repbyseq(e);
return 1;
}
return changed;
}
if (!is_var && !is_vis && name(def) == nof_tag) {
exp c = son(def);
int changed = 0;
int nuses = no(e);
int sz = rounder(shape_size(sh(c)), shape_align(sh(c)));
int nd = 0;
for(;; ) {
int n = name(c);
if (n == val_tag || n == real_tag || n == name_tag || n == null_tag){
exp u = pt(e);
for(; nuses!=0 && u!=nilexp; ) {
exp nextu = pt(u);
#ifdef NEWDIAGS
if (!isdiaginfo(u) && no(u)==nd && eq_shape(sh(u), sh(c))) {
#else
if (no(u)==nd && eq_shape(sh(u), sh(c))) {
#endif
replace(u, copy(c), bro(def));
nextu = pt(u); /* it could have changed */
kill_exp(u, bro(def));
nuses--;
changed = 1;
}
u = nextu;
}
}
if (nuses==0 || last(c)) break;
c = bro(c);
nd+=sz;
}
if ((no(e)==0 || pt(e) == nilexp) && !isenvoff(e) ) {
repbyseq(e);
return 1;
}
return changed;
}
return (0);
}