WebSVN – tendra.SVN – Diff – /trunk/src/installers/common/construct/check_id.c

+/*
+ * 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
 #endif
 #include "check_id.h"
 #if is68000
-extern int check_anyway PROTO_S ( ( exp ) ) ;
+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
-    PROTO_N ( (e, t) )
-    PROTO_T ( exp e X exp t )
+hc(exp e, exp t)
+{
-  setlast(t);
+	setlast(t);
-  bro(t) = e;
+	bro(t) = e;
-  return hold_check(e);
+	return hold_check(e);
+}
-static exp make_onearg
+static exp
-    PROTO_N ( (n, sha, a) )
-    PROTO_T ( unsigned char n X shape sha X exp a )
+make_onearg(unsigned char n, shape sha, exp a)
+{
-  exp r = getexp (sha, nilexp, 0, a, nilexp, 0, 0, n);
+	exp r = getexp(sha, nilexp, 0, a, nilexp, 0, 0, n);
-  return (hc (r, a));
+	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
+static exp
-    PROTO_N ( (n, sha, a, b) )
-    PROTO_T ( unsigned char n X shape sha X exp a X exp b )
+make_twoarg(unsigned char n, shape sha, exp a, exp b)
 {
-  exp r = getexp (sha, nilexp, 0, a, nilexp, 0, 0, n);
+	exp r = getexp(sha, nilexp, 0, a, nilexp, 0, 0, n);
-  bro (a) = b;
+	bro(a) = b;
-  clearlast (a);
+	clearlast(a);
-  return (hc (r, b));
+	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
+int
-    PROTO_N ( (vardec, piece) )
-    PROTO_T ( exp vardec X exp piece )
+used_in(exp vardec, exp piece)
+{
-  int  res = 0;
+	int  res = 0;
-  exp t = pt (vardec);
+	exp t = pt(vardec);
-  exp q;
+	exp q;
-  exp upwards = t;
+	exp upwards = t;
-  do {				/* test each use of the identifier */
+	/* test each use of the identifier */
+	do {
-    q = t;
+		q = t;
-    while (q != nilexp && q != piece && q != vardec && !parked(q) &&
+		while (q != nilexp && q != piece && q != vardec &&
-	(name (q) != ident_tag || !isglob(q))) {
+		       !parked(q) && (name(q) != ident_tag || !isglob(q))) {
-      upwards = q;
+			upwards = q;
-      q = bro (q);
+			q = bro(q);
-    };
+		}
-    /* ascend from the use until we reach either vardec or piece */
+		/* ascend from the use until we reach either vardec or piece */
-    if (last (upwards) && q == piece) {/* the use was in piece */
+		if (last (upwards) && q == piece) {
+			/* the use was in piece */
-      res = 1;
+			res = 1;
-      if ((last(t) || !last(bro(t)) || name(bro(bro(t))) != 0))  {
+			if ((last(t) || !last(bro(t)) ||
-        if (!last(t) ||
-          name(bro(t)) != cont_tag)
+			     name(bro(bro(t))) != 0)) {
-	res = 3;	/* the use was not contents or in diagnostics*/
+				/* the use was not contents or in diagnostics*/
+				if (!last(t) || name(bro(t)) != cont_tag) {
-     };
+					res = 3;
-    };
+				}
-    t = pt (t);
+			}
-  }
+		}
+		t = pt(t);
-  while (t != nilexp && res != 3);
+	} while (t != nilexp && res != 3);
-  return (res);
+	return(res);
+}
 /***********************************************************************
   simple_const tests whether e is used as a simple constant in whole.
   This is true in the following circumstances only.
      external to whole.
 ) 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
+int
-    PROTO_N ( (whole, e, decl, no_ass) )
-    PROTO_T ( exp whole X exp e X int decl X int no_ass )
+simple_const(exp whole, exp e, int decl, int no_ass)
 {
-  if (name (e) == val_tag || name (e) == real_tag || name (e) == null_tag)
+	if (name(e) == val_tag || name(e) == real_tag || name(e) == null_tag) {
-    return (1);
+		return(1);
+	}
-  if (name (e) == name_tag && !isvar (son (e)) &&
+	if (name(e) == name_tag && !isvar(son(e)) &&
-      (decl || !internal_to (whole, son (e))))
+	    (decl || !internal_to(whole, son(e)))) {
-    return (1);
+		return(1);
+	}
-  if (name (e) == reff_tag)
+	if (name(e) == reff_tag) {
-    e = son (e);
+		e = son(e);
+	}
-  if (name (e) == cont_tag && name (son (e)) == name_tag &&
+	if (name(e) == cont_tag && name(son(e)) == name_tag &&
-      !isparam (son (son (e))) &&
+	    !isparam(son(son(e))) && isvar(son(son(e)))) {
-      isvar (son (son (e)))) {
-    exp var = son (son (e));
+		exp var = son(son(e));
-    int  u = used_in (var, whole);
+		int  u = used_in(var, whole);
-    if (u != 3 && (iscaonly(var) || no_ass))
+		if (u != 3 && (iscaonly(var) || no_ass)) {
-      return (1);
+			return(1);
+		}
-    return (0);
+		return(0);
-  };
+	}
-  return (0);
+	return(0);
 }
-/* replace declaration by sequence of
+/* replace declaration by sequence of definition and body. Done if the
-   definition and body. Done if the
-   identifier is not used. */
+ * identifier is not used. */
-static void repbyseq
+static void
-    PROTO_N ( (e) )
-    PROTO_T ( exp e )
+repbyseq(exp e)
+{
-  exp def = son (e);
+	exp def = son(e);
-  exp body = hold_check(bro (def));
+	exp body = hold_check(bro(def));
-  exp seq, s;
+	exp seq, s;
 #ifdef NEWDIAGS
-  exp t = pt (e);
+	exp t = pt(e);
-  while (t != nilexp) {
+	while (t != nilexp) {
-    if (isdiaginfo(t))
+		if (isdiaginfo(t))
-      setdiscarded(t);
+			setdiscarded(t);
-    t = pt(t);
+		t = pt(t);
+	}
+#endif
+	if (son(def) == nilexp) {
+#ifdef NEWDIAGS
+		if (diagnose) {
+			dg_whole_comp(e, body);
-  }
+		}
 #endif
-  if (son (def) == nilexp) {
-#ifdef NEWDIAGS
-    if (diagnose)
-      dg_whole_comp (e, body);
-#endif
-    replace (e, body, e);
+		replace(e, body, e);
-    retcell (def);
+		retcell(def);
-    return;
+		return;
-  };
+	}
-  seq = getexp (f_bottom, nilexp, 0, def, nilexp, 0, 0, 0);
+	seq = getexp(f_bottom, nilexp, 0, def, nilexp, 0, 0, 0);
-  bro (def) = seq;
+	bro(def) = seq;
-  setlast (def);
+	setlast(def);
-  s = hold_check(make_twoarg (seq_tag, sh (body), seq, body));
+	s = hold_check(make_twoarg(seq_tag, sh(body), seq, body));
 #ifdef NEWDIAGS
-  if (diagnose)
+	if (diagnose) {
-    dg_whole_comp (e, s);
+		dg_whole_comp(e, s);
+	}
 #endif
-  replace (e, s, e);
+	replace(e, s, e);
-  return;
+	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
    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
+static int
-    PROTO_N ( (vardec, ende, plc, bfirst) )
-    PROTO_T ( exp vardec X exp ende X exp plc X int bfirst )
+propagate(exp vardec, exp ende, exp plc, int bfirst)
+{
-  exp p = plc;			/* starting place */
+	exp p = plc;		/* starting place */
-  int good = 1;		/* good is set to 0 when we find a 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 */
+	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;
-  };
+	/* 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 (name(p) == case_tag) {
-    if (propagate (vardec, son (p), son (p), 1))
+		if (propagate(vardec, son(p), son(p), 1)) {
-      goto up;
+			goto up;
+		}
-    good = 0;
+		good = 0;
-    goto ex;
+		goto ex;
+	}
+	if (son(p) == nilexp) {
+		goto up;
-  };
+	}
+	p = son(p);
+	goto rep;
-  if (son (p) == nilexp)
-    goto up;
-  p = son (p);
+ex:	return(good);
-  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
+static exp
-    PROTO_N ( (e, sha) )
-    PROTO_T ( exp e X shape sha )
+change_shape(exp e, shape sha)
+{
-  if (name (e) == val_tag)
+	if (name(e) == val_tag) {
-    no (e) = dochvar (no (e), sha);
+		no(e) = dochvar(no(e), sha);
+	}
-  sh (e) = sha;
+	sh(e) = sha;
-  return (e);
+	return(e);
+}
-static int change_cont
+static int
-    PROTO_N ( (vardec, val, force) )
-    PROTO_T ( exp vardec X exp val X int force )
+change_cont(exp vardec, exp val, int force)
 {
-  exp t;
+	exp t;
-  exp bh = hold (bro (son (vardec)));
+	exp bh = hold(bro(son(vardec)));
-  int ch = 0;
+	int ch = 0;
-  int go = 1;
+	int go = 1;
-  int defsize = shape_size(sh(son(vardec)));
+	int defsize = shape_size(sh(son(vardec)));
-  while (go) {
+	while (go) {
-    t = pt (vardec);
+		t = pt(vardec);
-    go = 0;
+		go = 0;
-    while (!go && t != nilexp) {
+		while (!go && t != nilexp) {
-      if (last (t) && name (bro (t)) == cont_tag &&
+			if (last(t) && name(bro(t)) == cont_tag &&
 #ifdef NEWDIAGS
-	  !isdiaginfo(t) &&
+			    !isdiaginfo(t) &&
 #endif
-	  (to_propagate (bro (t)) || force)) {
+			    (to_propagate(bro(t)) || force)) {
-        if (defsize == shape_size(sh(bro(t)))) {
+				if (defsize == shape_size(sh(bro(t)))) {
-	   exp p = bro (t);
+					exp p = bro(t);
-	   exp c = change_shape (copy (val), sh (p));
+					exp c = change_shape(copy(val), sh(p));
-	   kill_exp (t, son(bh));
+					kill_exp(t, son(bh));
-	   replace (p, c, son(bh));
+					replace(p, c, son(bh));
-	   retcell (p);
+					retcell(p);
-	   t = pt (vardec);
+					t = pt(vardec);
-	   ch = 1;
+					ch = 1;
-	   go = 1;
+					go = 1;
-        }
-        else
+				} else {
-          clear_propagate(bro(t));
+					clear_propagate(bro(t));
-      }
+				}
-      else
+			} else {
-	t = pt (t);
+				t = pt(t);
-    };
+			}
-  };
+		}
+	}
-  bro (son (vardec)) = son (bh);
+	bro(son(vardec)) = son(bh);
-  setlast (bro (son (vardec)));
+	setlast(bro(son(vardec)));
-  bro (bro (son (vardec))) = vardec;
+	bro(bro(son(vardec))) = vardec;
-  retcell (bh);
+	retcell(bh);
-  return (ch);
+	return(ch);
 }
 /*********************************************************************
    checks identity and variable declarations.
  *********************************************************************/
+int
-int check_id
-    PROTO_N ( (e, scope) )
-    PROTO_T ( exp e X exp scope )
+check_id(exp e, exp scope)
+{
-  int is_var = isvar (e);
+  int is_var = isvar(e);
-  int is_vis = (all_variables_visible || isvis (e));
+  int is_vis = (all_variables_visible || isvis(e));
-  exp def = son (e);
+  exp def = son(e);
-  exp body = bro (def);
+  exp body = bro(def);
   int looping;
   exp t1;
-  if ( no (e) == 0 )
+  if (no(e) == 0) {
-  {
-    if (!isvis(e) && !isenvoff(e) && !isglob (e) && !isparam(e)) {
+    if (!isvis(e) && !isenvoff(e) && !isglob(e) && !isparam(e)) {
-		/* the variable is not used */
+      /* the variable is not used */
-      repbyseq (e);
+      repbyseq(e);
-      return (1);
+      return(1);
+    } else {
+      if (isparam(e)) {
+	setcaonly(e);
+      }
+      return 0;
+    }
-    else
-     {
-       if (isparam(e))
-         setcaonly(e);
-       return 0;
-     };
-  };
+  }
 #if load_ptr_pars
-  if (!is_vis && is_var && isparam(e) && no(e) > 1 &&
+  if (!is_vis && is_var && isparam(e) && no(e) > 1 && name(sh(def)) == ptrhd
-	name(sh(def)) == ptrhd
 #if is68000
-	&& check_anyway(e)
+      && check_anyway(e)
 #endif
-	) {
+     ) {
     int ch_load = 1;
     int sz = shape_size(sh(def));
-    t1 = pt (e);
+    t1 = pt(e);
     looping = 1;
     do {
 #ifdef NEWDIAGS
       if (!isdiaginfo(t1)) {
 #endif
-	if (!last (t1) && last (bro (t1)) &&
-	    name (bro (bro (t1))) == ass_tag &&
+	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;
+	}
-	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)
+      if (pt(t1) == nilexp) {
-	  looping = 0;
+	looping = 0;
-	else
+      } else {
-	  t1 = pt (t1);
+	t1 = pt(t1);
-    }
+      }
-    while (looping && ch_load);
+    } 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))))
+      while (name(bro(son(t1))) == ident_tag && isparam(bro(son(t1)))) {
-        t1 = bro(son(t1));
+	t1 = bro(son(t1));
+      }
       real_body = bro(son(t1));
-      new_n = getexp(sh(def), real_body, 0, e, nilexp, 0,
+      new_n = getexp(sh(def), real_body, 0, e, nilexp, 0, 0, name_tag);
-, name_tag);
-      new_var = getexp(sh(e), nilexp, 0, new_n, old_pt_list,
+      new_var = getexp(sh(e), nilexp, 0, new_n, old_pt_list, 1, old_uses,
-, old_uses, ident_tag);
+		       ident_tag);
       setloadparam(new_n);
       setfather(new_var, real_body);
       pt(e) = new_n;
       no(e) = 1;
       clearvar(e);
-      while (old_pt_list != nilexp)
+      while (old_pt_list != nilexp) {
-       {
-         son(old_pt_list) = new_var;
+	son(old_pt_list) = new_var;
-         old_pt_list = pt(old_pt_list);
+	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)) &&
+      (name(def) != name_tag || !isloadparam(def)) &&
 #endif
-      (name (def) == val_tag ||
+      (name(def) == val_tag ||
 #if load_ptr_pars
-	(name (def) == name_tag &&
+       (name(def) == name_tag &&
-             (!isparam(son(def)) || name(sh(def)) == ptrhd))
+	(!isparam(son(def)) || name(sh(def)) == ptrhd))
 #else
-         name (def) == name_tag
+       name(def) == name_tag
 #endif
-          ||
+       ||
 #if is80x86
-	(name(def) == name_tag && isparam(son(def)) && !isvar(son(def)) &&
+       (name(def) == name_tag && isparam(son(def)) && !isvar(son(def)) &&
-		shape_size(sh(def)) < shape_size(sh(son(son(def)))) &&
+	shape_size(sh(def)) < shape_size(sh(son(son(def)))) &&
-		name(sh(def)) <= ulonghd) ||
+	name(sh(def)) <= ulonghd) ||
 #endif
-	( /* substitute the definitions of identity declarations into
+       /* substitute the definitions of identity declarations into body
-             body if it seems cheaper to do so */
+	* if it seems cheaper to do so */
-	  name (def) == reff_tag && name (son (def)) == cont_tag &&
+       (name(def) == reff_tag && name(son(def)) == cont_tag &&
-	  name (son (son (def))) == name_tag &&
+	name(son(son(def))) == name_tag && isvar(son(son(son(def)))) &&
-	  isvar (son (son (son (def)))) &&
-	  !isglob (son (son (son (def)))) &&
+	!isglob(son(son(son(def)))) &&
-	  used_in(son (son (son (def))), body) != 3
+	used_in(son(son(son(def))), body) != 3) ||
-	) ||
-	(
-	  name (def) == reff_tag && name (son (def)) == name_tag &&
+       (name(def) == reff_tag && name(son(def)) == name_tag &&
-	  isvar (son (son (def))) &&
-	  !isglob (son (son (def))) &&
+	isvar(son(son(def))) && !isglob(son(son(def))) &&
-	  used_in(son (son (def)), body) != 3
+	used_in(son(son(def)), body) != 3) || name(def) == null_tag ||
-	) ||
-	name (def) == null_tag ||
-	name (def) == real_tag)) {
+       name(def) == real_tag)) {
-/*     identifying a constant or named value */
+	 /* identifying a constant or named value */
-      {
 #if !substitute_params
-      int   do_anyway = 0;
+    int do_anyway = 0;
 #else
-      int   do_anyway = 1;
+    int do_anyway = 1;
 #endif
-      if (do_anyway || name (def) != name_tag ||
+    if (do_anyway || name(def) != name_tag || !isparam(son(def)) ||
-	  !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
-	  isvar (son (def))) {
+	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 {
-	exp bh = hold (body);
+	    sh(cp) = sh(mem);
+	  }
+	}
 #ifdef NEWDIAGS
-	dg_info dgh = dgf(def);
+	if (diagnose) {
-	dgf(def) = nildiag;	/* don't copy line info to all uses */
+	  dg_whole_comp(mem, cp);
+	}
 #endif
-	while (pt (e) != nilexp) {
-	  exp mem = pt (e);
+	replace(mem, cp, body);
-	  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;
+      dgf(def) = dgh;
 #endif
-	bro (def) = son (bh);
+      bro(def) = son(bh);
-	bro (bro (def)) = e;
+      bro(bro(def)) = e;
-	setlast (bro (def));
+      setlast(bro(def));
-	retcell (bh);
+      retcell(bh);
-	IGNORE check (e, scope);
+      IGNORE check(e, scope);
-	return (1);
+      return(1);
-      };
-    };
+    }
-  };
+  }
-  if (!is_vis && !is_var &&
-         name(def) == reff_tag && al1(sh(def)) == 1
+  if (!is_vis && !is_var && name(def) == reff_tag && al1(sh(def)) == 1) {
-     )  {  /* also substitute identity definitions which are references
+    /* also substitute identity definitions which are references
-              to bitfields. */
+       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)
+    if (diagnose) {
-      dg_whole_comp (def, son(def));
+      dg_whole_comp(def, son(def));
+    }
 #endif
     replace(def, son(def), son(def));
-    while (1)
+    while (1) {
-     {
-       k = pt(t);
+      k = pt(t);
-       q = getexp(sha, nilexp, 0, copy(t), nilexp, 0, n, reff_tag);
+      q = getexp(sha, nilexp, 0, copy(t), nilexp, 0, n, reff_tag);
-       sh(son(q)) = shb;
+      sh(son(q)) = shb;
-       q = hc(q, son(q));
+      q = hc(q, son(q));
-       replace(t, q, q);
+      replace(t, q, q);
-       kill_exp(t, t);
+      kill_exp(t, t);
-       if (k == nilexp)
+      if (k == nilexp) {
-         return 1;
+	return 1;
+      }
-       t = k;
+      t = k;
-     };
+    }
-  };
+  }
-  if (!is_vis && !is_var && name (def) == string_tag) {
+  if (!is_vis && !is_var && name(def) == string_tag) {
-         /* and substitute strings */
+    /* and substitute strings */
-    exp t = pt (e);
+    exp t = pt(e);
     int all_chars = 1;
     while (1) {
-      if (name (sh (t)) > ucharhd) {
+      if (name(sh(t)) > ucharhd) {
 	all_chars = 0;
 	break;
-      };
+      }
+      if (last (t)) {
-      if (last (t))	/* Surely this is wrong ??? */
+	/* Surely this is wrong ??? */
 	break;
+      }
-      t = pt (t);
+      t = pt(t);
-    };
+    }
     if (all_chars) {
       char *str = nostr(def);
-      t = pt (e);
+      t = pt(e);
       while (1) {
-	int l = (int)last (t);	/* Surely this is wrong ??? */
+	/* Surely this is wrong ??? */
+	int l = (int)last (t);
-	exp n = bro (t);
+	exp n = bro(t);
-	int  v = str[no (t) / 8];
+	int  v = str[no(t) / 8];
 	exp c;
-        if (name (sh (t)) == ucharhd)
+	if (name(sh(t)) == ucharhd) {
 	  v = v & 0xff;
+	}
-        c = getexp (sh (t), nilexp, 0, nilexp, nilexp, 0, v, val_tag);
+	c = getexp(sh(t), nilexp, 0, nilexp, nilexp, 0,
+		   v, val_tag);
-	replace (t, c, c);
+	replace(t, c, c);
-	kill_exp (t, t);
+	kill_exp(t, t);
-	if (l)
+	if (l) {
 	  break;
+	}
 	t = n;
-      };
+      }
-      if (no (e) == 0) {
+      if (no(e) == 0) {
-	replace (e, bro (son (e)), scope);
+	replace(e, bro(son(e)), scope);
-	return (1);
+	return(1);
-      };
+      }
-      return (0);
+      return(0);
-    };
+    }
-  };
+  }
-  if (!is_vis && !is_var &&
+  if (!is_vis && !is_var && name(body) == seq_tag &&
-      name (body) == seq_tag && name (son (son (body))) == ass_tag &&
+      name(son(son(body))) == ass_tag && name(bro(son(body))) == name_tag) {
-      name (bro (son (body))) == name_tag) {
-    exp tb = bro (son (son (son (body))));
+    exp tb = bro(son(son(son(body))));
-    if (name (tb) == name_tag && son (tb) == e &&
+    if (name(tb) == name_tag && son(tb) == e &&
-	son (bro (son (body))) == e &&
+	son(bro(son(body))) == e && last(son(son(body))) &&
-	last (son (son (body))) &&
-	sh (tb) == sh (def) && sh (tb) == sh (bro (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),
+      /*  e=id(def, seq(ass(tz, n(e)), n(e)) -> seq(ass(tz,
-         cont(tz)) */
+       *  def), cont(tz)) */
-      exp ass = son (son (body));
+      exp ass = son(son(body));
-      exp tz = son (ass);
+      exp tz = son(ass);
       exp r, s, c;
-      exp cz = copy (tz);
+      exp cz = copy(tz);
-      bro (tz) = def;
+      bro(tz) = def;
-      ass = hc (ass, def);
+      ass = hc(ass, def);
-      r = getexp (f_top, nilexp, 0, ass, nilexp, 0, 0, 0);
+      r = getexp(f_top, nilexp, 0, ass, nilexp, 0, 0, 0);
-      setlast (ass);
+      setlast(ass);
-      bro (ass) = r;
+      bro(ass) = r;
-      s = getexp (sh (body), nilexp, 0, r, nilexp, 0, 0, seq_tag);
+      s = getexp(sh(body), nilexp, 0, r, nilexp, 0, 0, seq_tag);
-      c = getexp (sh (body), s, 1, cz, nilexp, 0, 0, cont_tag);
+      c = getexp(sh(body), s, 1, cz, nilexp, 0, 0, cont_tag);
-      setbro (r, hc (c, cz));
+      setbro(r, hc(c, cz));
-      replace (e, hc (s, bro (son (s))), e);
+      replace(e, hc(s, bro(son(s))), e);
-      return (1);
+      return(1);
-    };
+    }
-  };
+  }
-    /* look to see if we can replace variable definitions by identities.
+  /* look to see if we can replace variable definitions by identities.
-       This can be done if there are only contents operations and no
+     This can be done if there are only contents operations and no
-       aliasing */
+     aliasing */
+  if (!is_vis && is_var) {
-  if (!is_vis && is_var) {	/* variable declaration */
+    /* variable declaration */
-    int all_c = 1;		/* every use is a contents operation */
+    int all_c = 1;	/* every use is a contents operation */
-    int all_a = 1;		/* every use is an assignment 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
+    int vardecass = 0;	/* there is an assignment of a variable
-				   (not its contents) (lhvalue in C
+			   (not its contents) (lhvalue in C
-				   terms). */
+			   terms). */
-    exp assd_val;		/* the assigned value */
+    exp assd_val;	/* the assigned value */
     int conversion = 0;
     int biggest_assigned_const = 0;
-    exp tc = pt (e);
+    exp tc = pt(e);
     int defsize = shape_size(sh(def));
+    do {
-    do {			/* scan the uses of the variable */
+      /* scan the uses of the variable */
-      if (last(tc) && (name(bro(tc)) == hold_tag || name(bro(tc))==hold2_tag)){
+      if (last(tc) && (name(bro(tc)) == hold_tag ||
+		       name(bro(tc)) == hold2_tag)) {
 #ifdef NEWDIAGS
-        if (diag_visible) {
+	if (diag_visible) {
 #else
-        if (diagnose) {
+	if (diagnose) {
 #endif
-		setvis(e);
+	  setvis(e);
-		return 0;
+	  return 0;
+	}
-      }
-      else  {
+      } else {
-      if (last (tc) && name (bro (tc)) == cont_tag && no(tc) == 0 &&
+	if (last(tc) && name(bro(tc)) == cont_tag && no(tc) == 0 &&
 #ifdef NEWDIAGS
-	   !isdiaginfo(tc) &&
+	    !isdiaginfo(tc) &&
 #endif
-           (name(sh(bro(tc)))<shrealhd || name(sh(bro(tc)))>doublehd ||
+	    (name(sh(bro(tc))) <shrealhd || name(sh(bro(tc))) >doublehd ||
-            (name(sh(def)) >= shrealhd && name(sh(def)) <= doublehd) )) {
+	     (name(sh(def)) >= shrealhd && name(sh(def)) <= doublehd))) {
-	int qq = shape_size(sh(bro (tc)));
+	  int qq = shape_size(sh(bro(tc)));
-	all_a = 0;		/* contents op so not all assignments */
+	  /* contents op so not all
+	   * assignments */
+	  all_a = 0;
-	if (name(father(bro(tc))) != test_tag)
+	  if (name(father(bro(tc))) != test_tag) {
-	  conversion = -1;
+	    conversion = -1;
-	if ((defsize != qq) &&
+	  }
-	    (name(sh(def)) < shrealhd))
+	  if ((defsize != qq) && (name(sh(def)) < shrealhd)) {
-         {
 #if is80x86
-	  if (!isparam(e) || no(e) != 1) {
+	    if (!isparam(e) || no(e) != 1) {
-	   if (no(tc) == 0 && defsize <= 32) {
+	      if (no(tc) == 0 && defsize <= 32) {
-	    if (qq == 8)
+		if (qq == 8) {
-	      setbyteuse(e);
+		  setbyteuse(e);
+		}
+	      } else {
+		all_c = 0;
+		not_aliased = 0;
+	      }
-	   }
+	    }
-	   else {
+#else
-            all_c = 0;
+	    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_c = 0;
+	      all_a = 0;
-	  not_aliased = 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)) {
+	/* set no alias flag if nothing but cont and ass */
+	setcaonly (e);
+      } else {
+	/* set visible flag if there is an alias */
+	setvis (e);
+	uses_loc_address = 1;
+      }
-      else {
+      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 (!last (tc) && last (bro (tc)) && no(tc) == 0 &&
+	  if (name(bro(tc)) == cont_tag) {
+	    sh(tc) = sh(bro(tc));
 #ifdef NEWDIAGS
-	    !isdiaginfo(tc) &&
+	    if (diagnose) {
+	      dg_whole_comp(bro(tc), tc);
+	    }
 #endif
-	    name (bro (bro (tc))) == ass_tag) {/* assignment op */
+	    replace(bro(tc), tc, tc);
-	  all_c = 0;		/* not all contents */
+	  }
-	  assd_val = bro (tc);
+	} while (pt(tc) != nilexp);
-	  if (name(assd_val) == val_tag) {
+	if (no(e) < 100) {
-	    if (no(assd_val) < 0 )
+	  for (i = 0; i < no(e); ++i) {
-	      conversion = -1;
+	    tc = e;
-	    if (no(assd_val) > biggest_assigned_const)
+	    for (j = 0; tc != nilexp && j <= i; ++j) {
+	      tc = pt(tc);
+#ifdef NEWDIAGS
-	      biggest_assigned_const = no(assd_val);
+	      while (tc != nilexp && isdiaginfo(tc))
+		tc = pt(tc);
+#endif
+	    }
+	    altered(tc, son(bh));
+	  }
-	  else
+	}
-	  if (name(assd_val) == chvar_tag &&
-		name(sh(son(assd_val))) <= uwordhd &&
-		is_signed(sh(son(assd_val)))) {
+	bro(def) = son(bh);
-	    int sz1 = shape_size(sh(son(assd_val)));
-	    if (conversion == 0)
+	bro(bro(def)) = e;
-	      conversion = sz1;
+	setlast(bro(def));
-	    else
+	retcell(bh);
-	    if (conversion != sz1)
+	IGNORE check(e, scope);
-	      conversion = -1;
+	return(1);
-	  }
+      }
-	  else
-	    conversion = -1;
+#if is80x86 || ishppa
+      /* look for places where we can avoid sign extending */
-	  if (defsize != shape_size(sh(assd_val)))
+      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));
-           {
+	    }
-#if is80x86
+	  } else {
-	    if (no(tc) == 0 && defsize <= 32) {
+	    if (name(bro(temp)) == val_tag) {
-	      if (shape_size(sh(bro(tc))) == 8)
+	      sh(bro(temp)) = ish;
-		setbyteuse(e);
+	    } else {
+	      bro(son(bro(temp))) = bro(bro(temp));
+	      bro(temp) = son(bro(temp));
+#if ishppa
+	      sh(bro(temp)) = (conversion == 8) ? ucharsh : uwordsh;
+#endif
+	    }
-	    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;
+	  temp = next;
-	  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);
+	replace(def, me_shint(slongsh, 0), def);
-        };
+      }
-      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
+      if (not_aliased && no(e) < 1000 &&
-	/* look for places where we can avoid sign extending */
+	  (name(sh(def)) < shrealhd || name(sh(def)) > doublehd) &&
-    if (not_aliased && name(sh(def)) == slonghd &&
+	  (ca || vardecass || name(def) == val_tag ||
-	  conversion == 16 && /* not 8 because of 80x86 regs */
+	   name(son(e)) == real_tag || name(def) == null_tag)) {
+	/* propagate constant assignment forward from the place where they
+	   occur */
-	  (biggest_assigned_const &
+	int  no_ass;
+	int chv;
-	    ((conversion == 8) ? (int)0xffffff80 : (int)0xffff8000)) == 0 &&
+	if (name(def) == val_tag || name(son(e)) == real_tag ||
-	name(def) == clear_tag) {
+	    name(def) == null_tag
-      exp temp = pt(e);
+	    /*
-      shape ish = (conversion == 8) ? scharsh : swordsh;
-      setse_opt(e);
+	       ||
-      while (temp != nilexp) {
+	       (name(def) == name_tag &&
-	exp next = pt(temp);
+	       isglob (son(def)))
-	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;
+	  do {
-	    replace(bro(temp), x, x);
+	    body = bro(def);
-	    IGNORE check(father(x), father(x));
+	    IGNORE propagate(e, e, body, 1);
-	    kill_exp(bro(temp), bro(temp));
+	  } while (change_cont(e, def, 0));
-	  };
+	}
-	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;
+	body = bro(def);
-      };
-      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;
+	  chv = 0;
-	no_ass = 0;
+	  no_ass = 0;
-	tc = pt (e);
+	  tc = pt(e);
-	while (!chv && tc != nilexp) {
+	  while (!chv && tc != nilexp) {
-	  if (!last (tc) &&
+	    if (!last(tc) &&
 #ifdef NEWDIAGS
-	      !isdiaginfo(tc) &&
+		!isdiaginfo(tc) &&
 #endif
-	      sh (bro (tc)) == sh (son (son (tc))) &&
+		sh(bro(tc)) == sh(son(son(tc))) && last(bro(tc)) &&
-	      last (bro (tc)) &&
-	      name (bro (bro (tc))) == ass_tag) {
+		name(bro(bro(tc))) == ass_tag) {
-	    exp var = bro (tc);
+	      exp var = bro(tc);
-	    exp va, df, bd;
+	      exp va, df, bd;
-	    if (eq_shape (sh (bro (tc)), sh (son (e))) &&
+	      if (eq_shape(sh(bro(tc)), sh(son(e))) &&
-		(name (bro (tc)) == val_tag ||
-		  name (bro (tc)) == real_tag ||
+		  (name(bro(tc)) == val_tag || name(bro(tc)) == real_tag ||
-		  name (bro (tc)) == null_tag
+		   name(bro(tc)) == null_tag
-/*
+		   /*
-		 ||
+		      ||
-		  (name (bro (tc)) == name_tag &&
+		      (name(bro(tc)) == name_tag &&
-		    isglob (son (bro (tc))))
+		      isglob (son(bro(tc))))
-*/
+		    */
-		 )) {
+		  )) {
-	      IGNORE propagate (e, e, bro (bro (tc)), 0);
+		IGNORE propagate(e, e, bro(bro(tc)), 0);
-	      chv = change_cont (e, bro (tc), 0);
+		chv = change_cont(e, bro(tc), 0);
-	      body = bro (def);
+		body = bro(def);
-	      ++no_ass;
+		++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;
-	    else {
+		    ++no(va);
-	      va = son (tc);
+		    tc = pt(tc);
+		  } while (pt(tc) != nilexp);
-	      df = son (var);
+		  pt(tc) = prev_uses;
-	      if (df != nilexp && (bd = bro(df)) != nilexp &&
-		  !isinlined(e) &&
-		  !isglob(va) && isvar(va) &&
-		  name (bd) == seq_tag &&
+		  if (name(df) == clear_tag) {
-		  name (bro (son (bd))) == cont_tag &&
-		  name (son (bro (son (bd)))) == name_tag &&
+		    ass = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0,
-		  son (son (bro (son (bd)))) == var &&
-		  isvar (var) &&
+				 top_tag);
-		  used_in (va, bd) == 0) {
-		exp a = son (bro (var));
+		  } else {
-		exp prev_uses, ass, seq_hold, s;
+		    ass = getexp(f_top, nilexp, 0, a, nilexp, 0, 0, ass_tag);
-		kill_exp (bro (son (bd)), body);
+		    bro(a) = df;
-		prev_uses = pt (va);
+		    bro(df) = ass;
-		tc = var;
-		pt (va) = pt (var);
+		    setlast(df);
-		do {
+		  }
-		  son (pt (tc)) = va;
+		  seq_hold = make_onearg(0, f_bottom, ass);
+		  s = make_twoarg(seq_tag, f_top, seq_hold, son(son(bd)));
-		  ++no (va);
+		  replace(bro(var), s, body);
-		  tc = pt (tc);
+		  chv = 1;
+		}
+	      }
+	    }
-		while (pt (tc) != nilexp);
+	    tc = pt(tc);
+	  }
-		pt (tc) = prev_uses;
+	} while (chv);
-		if (name (df) == clear_tag)
+#ifdef NEWDIAGS
-		  ass = getexp (f_top, nilexp, 0, nilexp, nilexp,
+	if (no(e) == no_ass && !isparam(e)) {
-, 0, top_tag);
+	  int diagonly = 1;
-		else {
+	  tc = pt(e);
-		  ass = getexp (f_top, nilexp, 0, a, nilexp,
+	  while (tc != nilexp) {
+	    if (!isdiaginfo(tc)) {
-, 0, ass_tag);
+	      if (diagnose) {
+		dg_rem_ass(bro(bro(tc)));
-		  bro (a) = df;
+	      }
+	      replace(bro(bro(tc)), bro(tc), bro(def));
-		  bro (df) = ass;
+	      diagonly = 0;
+	    }
-		  setlast (df);
+	    tc = pt(tc);
-		};
+	  }
-		seq_hold = make_onearg (0, f_bottom, ass);
-		s = make_twoarg (seq_tag, f_top, seq_hold,
+	  if (!diagonly) {
-                                  son (son (bd)));
-		replace (bro (var), s, body);
+	    repbyseq(e);
-		chv = 1;
+	  }
+	}
+#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);
-	  };
+	  }
-	  tc = pt (tc);
+	  repbyseq(e);
-	};
+	}
+#endif
+	return(1);
-      } while (chv) ;
+      }
+      if (!isparam(e) && name(def) == clear_tag && name(body) == seq_tag &&
-#ifdef NEWDIAGS
+	  name(son(son(body))) == ass_tag &&
-      if (no (e) == no_ass && !isparam(e)) {
+	  name(son(son(son(body)))) == name_tag &&
-	int diagonly = 1;
+	  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 */
-	tc = pt (e);
+	if (!used_in(e, val)) {
+	  son(e) = val;		/* put it in as initialisation */
-	while (tc != nilexp) {
+	  clearlast(val);
-	  if (!isdiaginfo(tc)) {
+	  bro(val) = body;
-	    if (diagnose)
+	  /* kill the use of var */
+	  kill_exp(son(son(son(body))), son(son(son(body))));
-	      dg_rem_ass (bro(bro(tc)));
+	  /* replace assignment by void */
-	    replace (bro (bro (tc)), bro (tc), bro(def));
+	  replace(son(son(body)), getexp(f_top, nilexp, 0, nilexp, nilexp, 0,
+, top_tag), body);
-	    diagonly = 0;
+	  return(1);
-	  }
+	}
-	  tc = pt (tc);
+      }
-	};
-	if (!diagonly)
+#ifdef NEWDIAGS
-	  repbyseq (e);
+      if (all_a && !isparam(e) && !diag_visible) {
-      };
 #else
-      if (no (e) == no_ass && pt (e) != nilexp && !isparam(e)) {
+      if (all_a && !isparam(e) && !diagnose) {
-	tc = pt (e);
-	while (replace (bro (bro (tc)), bro (tc), bro(def)),
-	    pt (tc) != nilexp)
-	  tc = pt (tc);
-	repbyseq (e);
-      };
 #endif
+	/* if only assignments replace them by evaluating the value assigned
+	 * and discarding it. replace the declaration by a sequence of
-      return (1);
+	 * definition and body */
-    };
+	tc = pt(e);
-    if (!isparam(e) && name (def) == clear_tag &&
-        name (body) == seq_tag &&
+	while (1) {
-	name (son (son (body))) == ass_tag &&
+	  if (!last(tc) && name(bro(bro(tc))) == ass_tag) {
-	name (son (son (son (body)))) == name_tag &&
-	son (son (son (son (body)))) == e &&
+#ifdef NEWDIAGS
-	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)) {
+	    if (diagnose) {
-        son (e) = val;		/* put it in as initialisation */
-        clearlast (val);
+	      dg_rem_ass(bro(bro(tc)));
-        bro (val) = body;
+	    }
-        /* kill the use of var */
+#endif
-        kill_exp (son (son (son (body))), son (son (son (body))));
+	    replace(bro(bro(tc)), bro(tc), body);
+	  }
-        replace (son (son (body)),
+	  tc = pt(tc);
-	    getexp (f_top, nilexp, 0, nilexp, nilexp, 0, 0, top_tag),
-	    body);		/* replace assignment by void */
+	  if (tc == nilexp) {
-        return (1);
+	    break;
-      };
+	  }
-    };
+	}
-#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);
+	repbyseq(e);
-      while (1)
-       {
-         if (!last(tc) && name(bro(bro(tc))) == ass_tag) {
-#ifdef NEWDIAGS
-	   if (diagnose)
-	     dg_rem_ass (bro(bro(tc)));
-#endif
+	return(1);
-           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) &&
+      if (!is_var && !is_vis && no(e) == 1 && !isparam(e) &&
-	name(body) == ident_tag && name(son(body)) == name_tag &&
+	  name(body) == ident_tag && name(son(body)) == name_tag &&
-	son(son(body)) == e &&
-	shape_size(def) == shape_size(son(body))) {
+	  son(son(body)) == e && shape_size(def) == shape_size(son(body))) {
 #ifdef NEWDIAGS
-    if (diagnose) {
+	if (diagnose) {
-      exp t = pt(e);
+	  exp t = pt(e);
-      while (t) {
+	  while (t) {
-	if (isdiaginfo(t))
+	    if (isdiaginfo(t)) {
-	  setdiscarded(t);
+	      setdiscarded(t);
+	    }
-	t = pt(t);
+	    t = pt(t);
-      }
+	  }
+	}
+#endif
+	replace(son(body), def, def);
+#ifdef NEWDIAGS
+	if (diagnose) {
+	  dg_whole_comp(e, body);
-    }
+	}
 #endif
-    replace(son(body), def, def);
-#ifdef NEWDIAGS
-    if (diagnose)
-      dg_whole_comp (e, body);
-#endif
-    replace(e, body, scope);
+	replace(e, body, scope);
-    return 1;
+	return 1;
-  };
+      }
-  if (!is_var && !is_vis && name(def) == compound_tag) {
+      if (!is_var && !is_vis && name(def) == compound_tag) {
 	exp c = son(def);
 	int nuses = no(e);
 	int changed = 0;
-	for(; ; ) {
+	for (;;) {
-	   int n = name(bro(c));
+	  int n = name(bro(c));
-	   if (n == val_tag || n == real_tag || n == name_tag ||
+	  if (n == val_tag || n == real_tag || n == name_tag || n == null_tag) {
-			 n == null_tag){
-	   	exp u = pt(e);
+	    exp u = pt(e);
-		for(; nuses !=0 && u!=nilexp; ) {
+	    for (; nuses !=0 && u !=nilexp;) {
-		    exp nextu = pt(u);
+	      exp nextu = pt(u);
 #ifdef NEWDIAGS
-		    if (!isdiaginfo(u) && no(u)==no(c) && eq_shape(sh(u), sh(bro(c))) ) {
+	      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))) ) {
+	      if (no(u) ==no(c) && eq_shape(sh(u), sh(bro(c)))) {
 #endif
-			replace(u, copy(bro(c)), bro(def));
+		replace(u, copy(bro(c)), bro(def));
-			nextu = pt(u); /* it could have changed */
+		nextu = pt(u); /* it could have changed */
-			kill_exp(u, bro(def));
+		kill_exp(u, bro(def));
-			nuses--;
+		nuses--;
-			changed = 1;
+		changed = 1;
-		    }
+	      }
-		    u = nextu;
+	      u = nextu;
-		}
+	    }
+	  }
-	    if (nuses ==0 || last(bro(c))) break;
+	  if (nuses ==0 || last(bro(c))) {
+	    break;
+	  }
-	    c = bro(bro(c));
+	  c = bro(bro(c));
 	}
-	if ((no(e)==0 || pt(e) == nilexp) && !isenvoff(e) ) {
+	if ((no(e) ==0 || pt(e) == nilexp) && !isenvoff(e)) {
-		repbyseq(e);
+	  repbyseq(e);
-		return 1;
+	  return 1;
+	}
 	return changed;
-  }
+      }
-  if (!is_var && !is_vis && name(def) == nof_tag) {
+      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(;; ) {
+	for (;;) {
-	   int n = name(c);
+	  int n = name(c);
-	   if (n == val_tag || n == real_tag || n == name_tag || n == null_tag){
+	  if (n == val_tag || n == real_tag || n == name_tag || n == null_tag) {
-	   	exp u = pt(e);
+	    exp u = pt(e);
-		for(; nuses!=0 && u!=nilexp; ) {
+	    for (; nuses !=0 && u !=nilexp;) {
-		    exp nextu = pt(u);
+	      exp nextu = pt(u);
 #ifdef NEWDIAGS
-		    if (!isdiaginfo(u) && no(u)==nd && eq_shape(sh(u), sh(c))) {
+	      if (!isdiaginfo(u) && no(u) ==nd && eq_shape(sh(u), sh(c))) {
 #else
-		    if (no(u)==nd && eq_shape(sh(u), sh(c))) {
+	      if (no(u) ==nd && eq_shape(sh(u), sh(c))) {
 #endif
-			replace(u, copy(c), bro(def));
+		replace(u, copy(c), bro(def));
-			nextu = pt(u); /* it could have changed */
+		nextu = pt(u); /* it could have changed */
-			kill_exp(u, bro(def));
+		kill_exp(u, bro(def));
-			nuses--;
+		nuses--;
-			changed = 1;
+		changed = 1;
-		    }
+	      }
-		    u = nextu;
+	      u = nextu;
-		}
+	    }
+	  }
-    	    if (nuses==0 || last(c)) break;
+	  if (nuses==0 || last(c)) {
+	    break;
+	  }
-	    c = bro(c);
+	  c = bro(c);
-	    nd+=sz;
+	  nd+=sz;
+	}
+	if ((no(e) ==0 || pt(e) == nilexp) && !isenvoff(e)) {
+	  repbyseq(e);
+	  return 1;
+	}
-	if ((no(e)==0 || pt(e) == nilexp) && !isenvoff(e) ) {
-		repbyseq(e);
-		return 1;
-	}
-	return changed;
+      return changed;
-  }
+      }
-  return (0);
+  return(0);
+}

Subversion Repositories tendra.SVN

(root)/trunk/src/installers/common/construct/check_id.c – Rev 2 → 7