Subversion Repositories tendra.SVN

/*

 * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.

 * All rights reserved.

 *

 * Redistribution and use in source and binary forms, with or without

 * modification, are permitted provided that the following conditions are met:

 *

 * 1. Redistributions of source code must retain the above copyright notice,

 *    this list of conditions and the following disclaimer.

 * 2. Redistributions in binary form must reproduce the above copyright notice,

 *    this list of conditions and the following disclaimer in the documentation

 *    and/or other materials provided with the distribution.

 * 3. Neither the name of The TenDRA Project nor the names of its contributors

 *    may be used to endorse or promote products derived from this software

 *    without specific, prior written permission.

 *

 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS

 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,

 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR

 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR

 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,

 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;

 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,

 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

 *

 * $Id$

 */

/*

    		 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(exp);

#endif

/* PROCEDURES */

/*********************************************************************

   make_onearg makes up an exp with the given tag (n), shape (sha)

   and single argument (a).

 *********************************************************************/

exp

hc(exp e, exp t)

{

	setlast(t);

	bro(t) = e;

	return hold_check(e);

}

static exp

make_onearg(unsigned char n, shape sha, 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(unsigned char n, shape sha, exp a, 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(exp vardec, exp piece)

{

	int  res = 0;

	exp t = pt(vardec);

	exp q;

	exp upwards = t;

	/* test each use of the identifier */

	do {

		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)) {

				/* the use was not contents or in diagnostics*/

				if (!last(t) || name(bro(t)) != cont_tag) {

					res = 3;

				}

			}

		}

		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(exp whole, exp e, int decl, 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(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(exp vardec, exp ende, exp plc, 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(exp e, shape sha)

{

	if (name(e) == val_tag) {

		no(e) = dochvar(no(e), sha);

	}

	sh(e) = sha;

	return(e);

}

static int

change_cont(exp vardec, exp val, 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(exp e, 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);

      /* don't copy line info to all uses */

      dgf(def) = nildiag;

#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) {

	/* Surely this is wrong ??? */

	int l = (int)last (t);

	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)) {