WebSVN – tendra.SVN – Diff – /branches/tendra5/src/installers/common/construct/check.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
  * Revision 1.36  1996/10/01  08:59:19  currie
  * correct chvar exceptions ADA
+ *
 Revision 1.35  1996/06/24 17:26:57  currie
 PIC code with name substitution
 Revision 1.34  1996/06/13 09:24:55  currie
 Bitfield alignments
 Revision 1.33  1996/06/05 15:29:48  currie
 parameter alignment in make_cmpd
  * Revision 1.25  1995/10/26  10:14:22  currie
  * solve_tag - kill_exp scope reduced
+ *
  * Revision 1.24  1995/10/17  12:59:23  currie
  * Power tests + case + diags
  *
  * Revision 1.24  1995/10/17  12:59:23  currie
  * Power tests + case + diags
+ *
  * Revision 1.23  1995/10/13  15:14:58  currie
  * case + long ints on alpha
  *
  * Revision 1.22  1995/10/12  15:52:47  currie
  * inlining bug
  *
  * Revision 1.21  1995/10/11  17:09:56  currie
  * avs errors
  *
  * Revision 1.20  1995/10/06  14:41:53  currie
  * Env-offset alignments + new div with ET
  *
  * Revision 1.18  1995/10/04  09:17:26  currie
  * CR95_371 + optimise compounds
+ *
  * Revision 1.17  1995/10/03  11:44:58  currie
  * field(compound)
  *
  * Revision 1.16  1995/10/02  10:55:54  currie
  * Alpha varpars + errhandle
+ *
  * Revision 1.15  1995/09/19  16:06:43  currie
  * isAlpha!!
+ *
  * Revision 1.14  1995/09/15  13:29:00  currie
  * hppa + add_prefix + r_w_m complex
  *
  * Revision 1.13  1995/09/11  15:35:32  currie
  * caller params -ve
+ *
  * Revision 1.12  1995/08/31  14:18:56  currie
  * mjg mods
 #include "localflags.h"
 #endif
 #include "check.h"
-extern shape containedshape PROTO_S ((int,int));
+extern shape containedshape(int, int);
 /* MACROS */
-  /* codes for error treaments */
+/* codes for error treaments */
 #define impossible 1
 #define ignore 2
 /* IDENTITIES */
-static int  masks[33] = {
+static int masks[33] = {
 ,
 x1, 0x3, 0x7, 0xf,
 x1f, 0x3f, 0x7f, 0xff,
 x1ff, 0x3ff, 0x7ff, 0xfff,
 x1fff, 0x3fff, 0x7fff, 0xffff,
 x1ffff, 0x3ffff, 0x7ffff, 0xfffff,
 x1fffff, 0x3fffff, 0x7fffff, 0xffffff,
 x1ffffff, 0x3ffffff, 0x7ffffff, 0xfffffff,
 x1fffffff, 0x3fffffff, 0x7fffffff, (int)0xffffffff
 };
 ntest int_inverse_ntest[] = {0, 4, 3, 2, 1, 6, 5};
-ntest real_inverse_ntest[] = {0, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1,
+ntest real_inverse_ntest[] = {0, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 12, 11, 14, 13};
-, 11, 14, 13};
-ntest exchange_ntest[] = {0, 3, 4, 1, 2, 5, 6, 9, 10, 7, 8, 11, 12, 13,
+ntest exchange_ntest[] = {0, 3, 4, 1, 2, 5, 6, 9, 10, 7, 8, 11, 12, 13, 14};
-};
 #if FBASE == 10
 static char maxdigs[] = "4294967296";
 #endif
   hold_check holds an exp as the son of a dummy exp and then
   applies check. After checking it retcells the dummy exp.
  ***********************************************************************/
 /* puts body on a hold */
-exp hold
+exp
-    PROTO_N ( (body) )
-    PROTO_T ( exp body )
+hold(exp body)
+{
-  exp body_hold = next_exp();
+	exp body_hold = next_exp();
-  son (body_hold) = body;
+	son(body_hold) = body;
-  bro (body) = body_hold;
+	bro(body) = body_hold;
-  setlast (body);
+	setlast(body);
-  bro (body_hold) = nilexp;
+	bro(body_hold) = nilexp;
 #if diagnose_registers
-  setname (body_hold, hold_tag);
+	setname(body_hold, hold_tag);
 #else
-  setname (body_hold, 102);
+	setname(body_hold, 102);
 #endif
-  return (body_hold);
+	return(body_hold);
+}
-exp hold_check
-    PROTO_N ( (r) )
-    PROTO_T ( exp r )
-{
-  exp h, sn;
-  h = hold (r);
-  IGNORE check (r, r);
-  sn = son (h);
-  bro(sn) = nilexp;
-  retcell (h);
-  return (sn);
-}
-exp hold_const_check
-    PROTO_N ( (r) )
-    PROTO_T ( exp r )
-{
-  exp ans;
-  int old = all_variables_visible;
-  all_variables_visible = 0;
-  ans = hold_check (r);
-  all_variables_visible = old;
-  return ans;
-}
-static exp varchange
-    PROTO_N ( (s, e) )
-    PROTO_T ( shape s X exp e )
-{
-				/* applies a change_var operation to e, to
-				   get shape s */
-  exp r = getexp (s, nilexp, 0, e, nilexp, 0, 0,
-      chvar_tag);
-  setlast(e);
-  bro(e) = r;
-  return (hold_check (r));
-}
-static int flpt_power_of_2
-    PROTO_N ( (f) )
-    PROTO_T ( flpt f )
-{
-  flt * r = &flptnos[f];
-  unsigned short us = r -> mant[0];
-  int i;
-  if ((us & (us - 1)) != 0)
-    return 0;
-  for (i = 1; i < MANT_SIZE; i++) {
-    if (r -> mant[i] != 0)
-      return 0;
-  };
+exp
+hold_check(exp r)
+{
+	exp h, sn;
+	h = hold(r);
+	IGNORE check(r, r);
+	sn = son(h);
+	bro(sn) = nilexp;
+	retcell(h);
+	return(sn);
+}
+exp
+hold_const_check(exp r)
+{
+	exp ans;
+	int old = all_variables_visible;
+	all_variables_visible = 0;
+	ans = hold_check(r);
+	all_variables_visible = old;
+	return ans;
+}
+static
+exp varchange(shape s, exp e)
+{
+	/* applies a change_var operation to e, to get shape s */
+	exp r = getexp(s, nilexp, 0, e, nilexp, 0, 0, chvar_tag);
+	setlast(e);
+	bro(e) = r;
+	return(hold_check(r));
+}
+static int
+flpt_power_of_2(flpt f)
+{
+	flt *r = &flptnos[f];
+	unsigned short us = r->mant[0];
+	int i;
+	if ((us & (us - 1)) != 0) {
+		return 0;
+	}
+	for (i = 1; i < MANT_SIZE; i++) {
+		if (r->mant[i] != 0) {
+			return 0;
+		}
+	}
-  return 1;
+	return 1;
+}
 /***********************************************************************
    eq_explist compares two descendant lists of exp for equality.
-   The given values, their bro's, bro(bro)'s  etc are compared until
+   The given values, their bro's, bro(bro)'s etc are compared until
-   an unequal pair is found or the end of one of the  lists (last) is
+   an unequal pair is found or the end of one of the lists (last) is
    found. In this case the lists are equal iff both ends have been
    reached.
  ***********************************************************************/
-static int eq_explist
+static int
-    PROTO_N ( (al, bl) )
-    PROTO_T ( exp al X exp bl )
+eq_explist(exp al, exp bl)
 {
-  if (al == nilexp && bl == nilexp)
+	if (al == nilexp && bl == nilexp) {
-    return (1);
+		return(1);
+	}
-  if (al == nilexp || bl == nilexp)
+	if (al == nilexp || bl == nilexp) {
-    return (0);
+		return(0);
+	}
-  if (!eq_exp (al, bl))
+	if (!eq_exp(al, bl)) {
-    return (0);
+		return(0);
+	}
-  if (last (al) && last (bl))
+	if (last(al) && last(bl)) {
-    return (1);
+		return(1);
+	}
-  if (last (al) || last (bl))
+	if (last(al) || last(bl)) {
-    return (0);
+		return(0);
+	}
-  return (eq_explist (bro (al), bro (bl)));
+	return(eq_explist(bro(al), bro(bl)));
 }
 /***********************************************************************
     eq_exp compares two exp for equality of effect. If the name of either
     exp is in the side-effecting group (!is_a) the exp are not equal.
     This is a crude test, but if it says the exps are equal this is so.
     contvol is forbidden.
  ***********************************************************************/
-int eq_exp
+int
+eq_exp(exp a, exp b)
+{
-    PROTO_N ( (a, b) )
+	if (name(a) == name(b)) {
+		if (name(a) == name_tag) {
+			return(son(a) == son(b) && no(a) == no(b) &&
-    PROTO_T ( exp a X exp b )
+			       eq_shape(sh(a), sh(b)));
+		}
+		if (!is_a(name(a)) || !eq_shape(sh(a), sh(b)) ||
+		    name(a) == contvol_tag) {
+			return(0);
+		}
+		if (name(a) == real_tag) {
+			int res = flt_cmp(flptnos[no(a)], flptnos[no(b)]);
+			return(res == 0);
+		}
+		if (name(a) == val_tag) {
+			if (isbigval(a)) {
+				int res;
+				if (!isbigval(b)) {
+					return 0;
+				}
+				res = flt_cmp(flptnos[no(a)], flptnos[no(b)]);
+				return(res == 0);
+			}
+			if (isbigval(b)) {
+				return 0;
+			}
+			return(no(a) == no(b));
+		}
+		return(no(a) == no(b) && eq_explist(son(a), son(b)));
+	}
+	return(0);
+}
+/**********************************************************************
+   repbycont replaces e by the exp which loads top, ie. does nothing.
+ **********************************************************************/
+static void
+repbycont(exp e, bool has_label, exp scope)
+{
-  if (name (a) == name (b)) {
-    if (name (a) == name_tag)
-      return (son (a) == son (b) && no (a) == no (b) &&
+	exp n = getexp(f_top, bro(e), (int)(last(e)), nilexp, nilexp, 0, 0,
-	  eq_shape (sh (a), sh (b)));
-    if (!is_a (name (a)) || !eq_shape (sh (a), sh (b)) ||
-		 name(a) == contvol_tag)
+		       top_tag);
-      return (0);
+	if (has_label) {
-    if (name (a) == real_tag) {
+		no(son(pt(e)))--;
-      int   res = flt_cmp (flptnos[no (a)], flptnos[no (b)]);
-      return (res == 0);
+		pt(e) = nilexp;
-    };
+	}
-    if (name(a) == val_tag)  {
-      if (isbigval(a)) {
-	int res;
+#ifdef NEWDIAGS
-	if (!isbigval(b))
+	dgf(n) = dgf(e);
-	  return 0;
+#endif
-	res = flt_cmp (flptnos[no (a)], flptnos[no (b)]);
-        return (res == 0);
+	replace(e, n, e);
-      };
-      if (isbigval(b))
-	return 0;
+	kill_exp(e, e);
-      return (no(a) == no(b));
-    };
-    return (no (a) == no (b) &&
+	if (scope !=e) {
-	eq_explist (son (a), son (b)));
+		altered(n, scope);
-  };
+	}
-  return (0);
+}
 /**********************************************************************
-   repbycont replaces e by the exp which loads top, ie. does nothing.
+   repbygo replaces e by a goto the label.
  **********************************************************************/
-static void repbycont
+static void
-    PROTO_N ( (e, has_label, scope) )
-    PROTO_T ( exp e X bool has_label X exp scope )
+repbygo(exp e, exp lab, exp scope)
+{
-  exp n = getexp (f_top, bro (e), (int)(last (e)), nilexp, nilexp, 0, 0, top_tag);
+	exp g = getexp(f_bottom, nilexp, 0, nilexp, lab, 0, 0, goto_tag);
-  if (has_label) {
+	exp n = getexp(f_top, g, 1, nilexp, nilexp, 0, 0, top_tag);
-    no (son (pt (e)))--;
+	son(g) = n;
-    pt (e) = nilexp;
+	++no(son(lab));
-  };
 #ifdef NEWDIAGS
-  dgf(n) = dgf(e);
+	dgf(g) = dgf(e);
 #endif
-  replace (e, n, e);
+	replace(e, g, e);
-  kill_exp (e, e);
+	kill_exp(e, e);
+	if (scope !=e) {
-  if (scope !=e) altered(n,scope);
+		altered(g, scope);
+	}
+}
 /**********************************************************************
-   repbygo replaces e by a goto the label.
+   nos tests the exp t to see if it is a construction that can be
+   eliminated from a sequence.  It is ignorable or has no side effect.
  **********************************************************************/
+static int nos(exp t);
-static void repbygo
+static int
-    PROTO_N ( (e, lab, scope) )
+noslist(exp tl)
-    PROTO_T ( exp e X exp lab X exp scope )
 {
-  exp g = getexp (f_bottom, nilexp, 0, nilexp, lab, 0, 0, goto_tag);
-  exp n = getexp (f_top, g, 1, nilexp, nilexp, 0, 0, top_tag);
-  son (g) = n;
-  ++no (son (lab));
+	if (tl == nilexp) {
-#ifdef NEWDIAGS
-  dgf(g) = dgf(e);
+		return(1);
-#endif
+	}
-  replace (e, g, e);
+	if (last(tl)) {
-  kill_exp (e, e);
+		return(nos(tl));
+	}
-  if (scope !=e) altered(g,scope);
+	return(nos(tl) && noslist(bro(tl)));
+}
-/**********************************************************************
-   nos tests the exp t to see if it is a construction that can be
-   eliminated from a sequence.  It is ignorable or has no side effect.
- **********************************************************************/
-static int nos PROTO_S ((exp t));
-static int noslist
+static int
-    PROTO_N ( (tl) )
-    PROTO_T ( exp tl )
+nos(exp t)
 {
-  if (tl == nilexp)
+	unsigned char n = name(t);
-    return (1);
-  if (last (tl))
+	if (n == top_tag || n == ignorable_tag) {
-    return (nos (tl));
+		return(1);
-  return (nos (tl) && noslist (bro (tl)));
-}
+	}
-static int nos
-    PROTO_N ( (t) )
+	if (n == compound_tag || n == nof_tag) {
-    PROTO_T ( exp t )
+		return noslist(son(t));
-{
+	}
-  unsigned char n = name(t);
-  if (n == top_tag || n == ignorable_tag)
-    return (1);
-  if (n == compound_tag || n == nof_tag) return noslist(son(t));
-  return (	(is_a (n) &&
+	return((is_a(n) && optop(t) &&
-		 optop(t) &&
-		 ((n == name_tag && !islastuse(t)) ||
+		((n == name_tag && !islastuse(t)) || n == val_tag ||
-		  n == val_tag ||
-		  noslist (son (t))
-		 )
-		) ||
-           	(n == ident_tag && !isenvoff(t) &&
+		 noslist(son(t)))) || (n == ident_tag && !isenvoff(t) &&
-		 nos (son (t)) &&
-	     	 nos (bro (son (t)))
+				       nos(son(t)) && nos(bro(son(t)))));
-		)
-	 );
 }
 /**********************************************************************
    check_seq carries out transformations on sequences.
    Statements with no effect are removed.
    Anything after an unconditional goto, or any other statement
    producing a bottom shape, is removed.
    No changes are propagated outside the exp "scope".
  **********************************************************************/
-static int maxes [] = {0, 0, 0, 127, 255, 32767, 65535,
+static int maxes[] = {0, 0, 0, 127, 255, 32767, 65535, (int)0x7fffffff,
-		 (int)0x7fffffff, (int)0xffffffff};
+	(int)0xffffffff};
 static int mins[] = {0, 0, 0, -128, 0, -32768, 0, (int)0xffffffff, 0};
 /**********************************************************************
    comm_ass applies the commutative and associative laws to replace e
    by an improved version. op_tag is the operation involved. If
    (integer or real) and delivers an exp defining a constant which is
    the result of the op_tag applied to these constants.
  **********************************************************************/
-static int  f_one PROTO_S ((flpt f));
+static int f_one(flpt f);
-static int seq_distr PROTO_S ((exp e, exp scope));
+static int seq_distr(exp e, exp scope);
-static int comm_ass
-    PROTO_N ( (e, op_tag, fn, one, has_zero, zero, scope, dive, isreal) )
-    PROTO_T ( exp e X unsigned char op_tag X
-	      void  (*fn) PROTO_S (( exp, exp, int )) X
-	      int one X int has_zero X int zero X exp scope X
-	      int dive X int isreal )
-{
-  exp t = son (e);		/* starting element */
-  int changed = last (t);
-  exp  cst;		/* start the accumulated constant */
-  exp cst_u = nilexp;	/* holds exp representing one if created here */
-  int looping;
-  if (isreal)
-     cst = getexp (sh (e), nilexp, 0, nilexp, nilexp, 0, one, real_tag);
-  else  {
-     cst = me_shint(sh(e), one);
-     if (one == -1 && shape_size(sh(e)) == 64) {
-	flpt f = new_flpt();
-	flt * fp = &flptnos[f];
-	int i;
-	fp->sign = 1;
-	fp->exp = 3;
-	for (i=0; i< 4; ++i)
-	  fp->mant[i] = 65535;
-	no(cst) = f;
-	setbigval(cst);
-        cst_u = cst;
-     };
-  };
+static int
+comm_ass(exp e, unsigned char op_tag, void (*fn)(exp, exp, int), int one,
+	 int has_zero, int zero, exp scope, int dive, int isreal)
+{
+	exp t = son(e);	/* starting element */
+	int changed = last(t);
+	exp cst;		/* start the accumulated constant */
+	exp cst_u = nilexp;	/* holds exp representing one if created here */
+	int looping;
+	if (isreal) {
+		cst = getexp(sh(e), nilexp, 0, nilexp, nilexp, 0, one,
+			     real_tag);
+	} else {
+		cst = me_shint(sh(e), one);
+		if (one == -1 && shape_size(sh(e)) == 64) {
+			flpt f = new_flpt();
+			flt *fp = &flptnos[f];
+			int i;
+			fp->sign = 1;
+			fp->exp = 3;
+			for (i = 0; i < 4; ++i) {
+				fp->mant[i] = 65535;
+			}
+			no(cst) = f;
+			setbigval(cst);
+			cst_u = cst;
+		}
+	}
-  if (!optop(e))
+	if (!optop(e)) {
-    return 0;
+		return 0;
+	}
+	do {
-  do {				/* look to see if a change will be made */
+		/* look to see if a change will be made */
-    if ((name (t) == op_tag && optop(t)) || name (t) == val_tag ||
+		if ((name(t) == op_tag && optop(t)) || name(t) == val_tag ||
-           name(t) == real_tag)
+		    name(t) == real_tag) {
-      changed = 1;
+			changed = 1;
+		}
-    looping = !last (t);
+		looping = !last(t);
-    t = bro (t);
+		t = bro(t);
-  }
-  while (looping);
+	} while (looping);
+	if (changed) {
-  if (changed) {		/* continue if there will be a change */
+		/* continue if there will be a change */
-    exp p, q;
+		exp p, q;
-    t = son (e);		/* start */
+		t = son(e);	/* start */
-    q = getexp (sh (e), nilexp, 0, nilexp, nilexp, 0, 0, op_tag);
+		q = getexp(sh(e), nilexp, 0, nilexp, nilexp, 0, 0, op_tag);
-    seterrhandle(q, errhandle(e));
+		seterrhandle(q, errhandle(e));
-    /* start the result */
+		/* start the result */
+		p = q;
-    p = q;			/* p is used to point to the current place
+		/* p is used to point to the current place where the next item
-				   where the next item will be added (as
-				   bro). */
+		 * will be added (as bro). */
-    do {
+		do {
-      while (name (t) == op_tag && optop(t) && dive)
+			while (name(t) == op_tag && optop(t) && dive) {
-	t = son (t);		/* dive down same operator */
+				t = son(t);	/* dive down same operator */
+			}
-      if (name (t) == val_tag || name(t) == real_tag) {
+			if (name(t) == val_tag || name(t) == real_tag) {
-	fn (cst, t, errhandle(e));	/* accumulate constant value */
+				/* accumulate constant value */
+				fn (cst, t, errhandle(e));
 #ifdef NEWDIAGS
-	if (diagnose)
+				if (diagnose) {
-	  dg_detach_const (t, cst);
+					dg_detach_const(t, cst);
+				}
 #endif
-      }
+			} else {
-      else {			/* add item at p and move p on */
+				/* add item at p and move p on */
-	bro (p) = t;
+				bro(p) = t;
-	clearlast (p);
+				clearlast(p);
-	p = bro (p);
+				p = bro(p);
-      };
+			}
-      while (last (t) && bro (t) != e)
+			while (last(t) && bro(t) != e) {
-	t = bro (t);		/* ascend from sub-item */
+				/* ascend from sub-item */
+				t = bro(t);
-    }
+			}
-    while ((last (t)) ? 0 : (t = bro (t), 1));
+		} while ((last(t)) ? 0 : (t = bro(t), 1));
-    son (q) = bro (q);		/* put q into correct form (we were using
+		/* put q into correct form (we were using its bro) */
-				   its bro) */
+		son(q) = bro(q);
-    if (p == q) {
+		if (p == q) {
-      /* no items but constant */
+			/* no items but constant */
-      retcell(q);
+			retcell(q);
 #ifdef NEWDIAGS
-      if (diagnose)
+			if (diagnose) {
-	dg_whole_comp (e, cst);
+				dg_whole_comp(e, cst);
+			}
 #endif
-      replace (e, cst, scope);
+			replace(e, cst, scope);
-      retcell(e);
+			retcell(e);
-      return (1);
+			return(1);
-    };
+		}
-    if (has_zero &&
+		if (has_zero &&
-         ((!isreal && no(cst) == zero && !isbigval(cst)) ||
+		    ((!isreal && no(cst) == zero && !isbigval(cst)) ||
-          (isreal && flptnos[no(cst)].sign == 0))) {
+		     (isreal && flptnos[no(cst)].sign == 0))) {
-      /* zero constant. Replace by a sequence of expressions delivering
+			/* zero constant. Replace by a sequence of expressions
-         the zero, so as to keep side effects */
+			 * delivering the zero, so as to keep side effects */
-      exp r;
+			exp r;
-      setname (q, 0);		/* use q a seq holder */
+			setname(q, 0);		/* use q a seq holder */
-      son (q) = bro (q);
+			son(q) = bro(q);
-      bro (p) = q;
+			bro(p) = q;
-      setlast (p);
+			setlast(p);
-      clearlast (q);
+			clearlast(q);
-      bro (q) = cst;
+			bro(q) = cst;
-      r = getexp (sh (e), nilexp, 0, q, nilexp, 0, 0, seq_tag);
+			r = getexp(sh(e), nilexp, 0, q, nilexp, 0, 0, seq_tag);
+#ifdef NEWDIAGS
+			if (diagnose) {
+				dgf(r) = dgf(e);
+			}
+#endif
+			replace(e, hc(r, cst), scope);
+			return(1);
+		}
+		if ((!isreal &&
+		     (no(cst) != one || (isbigval(cst) && cst != cst_u))) ||
+		    (isreal && cmpflpt(no(cst), one, 6))) {
+			/* form result if there is a non-unit constant term */
+			bro(p) = cst;
+			clearlast(p);
+			p = bro(p);
+			son(q) = bro(q);
+			bro(p) = q;
+			setlast(p);
+			sh(q) = sh(e);
 #ifdef NEWDIAGS
-      if (diagnose)
+			if (diagnose) {
-	dgf(r) = dgf(e);
+				dgf(q) = dgf(e);
+			}
 #endif
-      replace (e, hc (r, cst), scope);
+			replace(e, q, scope);
+			retcell(e);
-      return (1);
+			return(1);
-    };
+		}
-    if ((!isreal &&
-		(no(cst) != one || (isbigval(cst) && cst != cst_u))) ||
-         (isreal && cmpflpt(no(cst), one, 6))) {
-		/* form result if there is a non-unit
-				   constant term */
-      bro (p) = cst;
-      clearlast (p);
-      p = bro (p);
-      son (q) = bro (q);
-      bro (p) = q;
-      setlast (p);
-      sh (q) = sh (e);
 #ifdef NEWDIAGS
-      if (diagnose)
+		if (diagnose) {
-	dgf(q) = dgf(e);
+			dgf(e) = combine_diaginfo(dgf(e), dgf(cst));
+		}
 #endif
-      replace (e, q, scope);
+		retcell(cst);   /* there are no constants other than unit*/
-      retcell(e);
-      return (1);
-    };
+		if (son(q) == p) {
+			/* form result if single item and no constant */
+			sh(p) = sh(e);
 #ifdef NEWDIAGS
-    if (diagnose)
+			if (diagnose) {
-      dgf(e) = combine_diaginfo (dgf(e), dgf(cst));
+				dg_whole_comp(e, p);
+			}
 #endif
-    retcell(cst);   /* there are no constants other than unit*/
-    if (son (q) == p) {		/* form result if single item and no
-				   constant */
-      sh (p) = sh (e);
-#ifdef NEWDIAGS
-      if (diagnose)
-	dg_whole_comp (e, p);
-#endif
-      replace (e, hold_check(p), scope);
+			replace(e, hold_check(p), scope);
-      retcell(e);
+			retcell(e);
-      return (1);
+			return(1);
-    };
+		}
-    bro (p) = q;		/* form result if no constant and more
+		/* form result if no constant and more than one arg */
-				   than one arg */
+		bro(p) = q;
-    setlast (p);
+		setlast(p);
-    sh (q) = sh (e);
+		sh(q) = sh(e);
 #ifdef NEWDIAGS
-    if (diagnose)
+		if (diagnose) {
-      dg_whole_comp (e, q);
+			dg_whole_comp(e, q);
+		}
 #endif
 /* used as a fn parameter for comm_ass q.v. */
-static void fmult_fn
-    PROTO_N ( (ap, b, et) )
-    PROTO_T ( exp ap X exp b X int et )
-{
-  int a = no(ap);
-  int  nob = no (b);
-  flt resval;
-  int status;
-  UNUSED (et);
-  status = flt_mul (flptnos[a], flptnos[nob], &resval);
-  if (status == OKAY) {
+static void
-      flpt_round((int)f_to_nearest,
+fmult_fn(exp ap, exp b, int et)
-		 flpt_bits((floating_variety)(name(sh(b))-shrealhd)),
+{
-		 &resval);
+	int a = no(ap);
-      flptnos[nob] = resval;
-      no(ap) = nob;
+	int nob = no(b);
-    }
+	flt resval;
-  else
+	int status;
-    failer(ILLEGAL_FLMULT);
-  return;
+	UNUSED(et);
-}
+	status = flt_mul(flptnos[a], flptnos[nob], &resval);
+	if (status == OKAY) {
+		flpt_round((int)f_to_nearest,
+			   flpt_bits((floating_variety)(name(sh(b)) -
+							shrealhd)), &resval);
+		flptnos[nob] = resval;
+		no(ap) = nob;
+	} else {
+		failer(ILLEGAL_FLMULT);
+	}
+	return;
+}
 /* auxiliary function used for comm_ass by plus */
-static void plus_fn
-    PROTO_N ( (ap, b, et) )
-    PROTO_T ( exp ap X exp b X int et )
-{
-  flt64 x;
-  flpt fa, fb;
-  int sg = is_signed(sh(ap));
-  flt resval;
-  int ov;
-  fa = f64_to_flt(exp_to_f64(ap), sg);
-  fb = f64_to_flt(exp_to_f64(b), sg);
-  IGNORE flt_add (flptnos[fa], flptnos[fb], &resval);
-		/* status cannot be wrong */
-  flptnos[fa] = resval;
-  x = flt_to_f64(fa, sg, &ov);
-  if (et != f_wrap.err_code &&
-	(ov || constovf(b) || check_size(x, sg, shape_size(sh(ap)))))
-    setconstovf(ap);
-/*  if (extra_checks && sg && !in_proc_def &&
-	(ov || (shape_size(sh(ap)) <= 32 && check_size(x, sg, 32)))) {
-    failer(ADD_OUT_OF_BOUNDS);
-    exit(EXIT_FAILURE);
-  };
-*/
-  flpt_ret(fa);
-  flpt_ret(fb);
-  bigres(ap, &x);
-  return;
-}
-/* subtract constant from constant */
-static void minus_fn
-    PROTO_N ( (ap, b, et) )
-    PROTO_T ( exp ap X exp b X int et )
-{
-  flt64 x;
-  flpt fa, fb;
-  int sg = is_signed(sh(ap));
-  flt resval;
-  int ov;
-  fa = f64_to_flt(exp_to_f64(ap), sg);
-  fb = f64_to_flt(exp_to_f64(b), sg);
-  IGNORE flt_sub (flptnos[fa], flptnos[fb], &resval);
-		/* status cannot be wrong */
-  flptnos[fa] = resval;
-  x = flt_to_f64(fa, sg, &ov);
-  if (et != f_wrap.err_code &&
-	(ov || constovf(b) || check_size(x, sg, shape_size(sh(ap)))))
-    setconstovf(ap);
-/*  if (extra_checks && sg && !in_proc_def &&
-	(ov || (shape_size(sh(ap)) <= 32 && check_size(x, sg, 32)))) {
-    failer(ADD_OUT_OF_BOUNDS);
-    exit(EXIT_FAILURE);
-  };
-*/
-  flpt_ret(fa);
-  flpt_ret(fb);
-  bigres(ap, &x);
-  return;
-}
+static void
+plus_fn(exp ap, exp b, int et)
+{
+	flt64 x;
+	flpt fa, fb;
+	int sg = is_signed(sh(ap));
+	flt resval;
+	int ov;
+	fa = f64_to_flt(exp_to_f64(ap), sg);
+	fb = f64_to_flt(exp_to_f64(b), sg);
+	IGNORE flt_add(flptnos[fa], flptnos[fb], &resval);
+	/* status cannot be wrong */
+	flptnos[fa] = resval;
+	x = flt_to_f64(fa, sg, &ov);
+	if (et != f_wrap.err_code &&
+	    (ov || constovf(b) || check_size(x, sg, shape_size(sh(ap))))) {
+		setconstovf(ap);
+	}
+	/* if (extra_checks && sg && !in_proc_def &&
+	    (ov || (shape_size(sh(ap)) <= 32 && check_size(x, sg, 32)))) {
+	    failer(ADD_OUT_OF_BOUNDS);
+	    exit(EXIT_FAILURE);
+	    };
+	 */
+	flpt_ret(fa);
+	flpt_ret(fb);
+	bigres(ap, &x);
+	return;
+}
-/* negate a constant exp, b, producing int */
+/* subtract constant from constant */
-static void  neg_fn
+static void
+minus_fn(exp ap, exp b, int et)
+{
+	flt64 x;
+	flpt fa, fb;
+	int sg = is_signed(sh(ap));
+	flt resval;
+	int ov;
+	fa = f64_to_flt(exp_to_f64(ap), sg);
+	fb = f64_to_flt(exp_to_f64(b), sg);
+	IGNORE flt_sub(flptnos[fa], flptnos[fb], &resval);
+	/* status cannot be wrong */
+	flptnos[fa] = resval;
+	x = flt_to_f64(fa, sg, &ov);
+	if (et != f_wrap.err_code &&
+	    (ov || constovf(b) || check_size(x, sg, shape_size(sh(ap))))) {
+		setconstovf(ap);
+	}
+	/* if (extra_checks && sg && !in_proc_def &&
+	    (ov || (shape_size(sh(ap)) <= 32 && check_size(x, sg, 32)))) {
+	    failer(ADD_OUT_OF_BOUNDS);
-    PROTO_N ( (b) )
+	    exit(EXIT_FAILURE);
+	    };
+	 */
+	flpt_ret(fa);
+	flpt_ret(fb);
+	bigres(ap, &x);
+	return;
+}
+/* negate a constant exp, b, producing int */
+static void
-    PROTO_T ( exp b )
+neg_fn(exp b)
 {
-  flt64 x;
+	flt64 x;
-  x = exp_to_f64(b);
+	x = exp_to_f64(b);
-  x.big = ~x.big;
+	x.big = ~x.big;
-  x.small = ~x.small;
+	x.small = ~x.small;
-  if (x.small == (unsigned int)0xffffffff) {
+	if (x.small == (unsigned int)0xffffffff) {
-    ++x.big;
+		++x.big;
-  };
+	}
-  ++x.small;
+	++x.small;
+	bigres(b, &x);
+	return;
+}
+/* negate a constant exp, b, producing int */
+static void
+not_fn(exp b)
+{
+	flt64 x;
+	x = exp_to_f64(b);
+	x.big = ~x.big;
+	x.small = ~x.small;
-  bigres(b, &x);
+	bigres(b, &x);
-  return;
+	return;
+}
-/* negate a constant exp, b, producing int */
-static void  not_fn
-    PROTO_N ( (b) )
-    PROTO_T ( exp b )
-{
-  flt64 x;
-  x = exp_to_f64(b);
-  x.big = ~x.big;
-  x.small = ~x.small;
-  bigres(b, &x);
-  return;
-}
 /* auxiliary function used for comm_ass by mult */
-static void mult_fn
-    PROTO_N ( (ap, b, et) )
-    PROTO_T ( exp ap X exp b X int et )
-{
-  flt64 x;
-  flpt fa, fb;
-  int sg = is_signed(sh(ap));
-  flt resval;
-  int ov;
-  fa = f64_to_flt(exp_to_f64(ap), sg);
-  fb = f64_to_flt(exp_to_f64(b), sg);
-  IGNORE flt_mul (flptnos[fa], flptnos[fb], &resval);
-		/* status cannot be wrong */
-  flptnos[fa] = resval;
-  x = flt_to_f64(fa, sg, &ov);
-  if (et != f_wrap.err_code &&
-	(ov || constovf(b) || check_size(x, sg, shape_size(sh(ap)))))
-    setconstovf(ap);
-  if (sg && extra_checks &&
-	(ov || (shape_size(sh(ap)) <= 32 && check_size(x, sg, 32)))) {
-    failer(MULT_OUT_OF_BOUNDS);
-    exit(EXIT_FAILURE);
-  };
+static void
+mult_fn(exp ap, exp b, int et)
+{
+	flt64 x;
+	flpt fa, fb;
+	int sg = is_signed(sh(ap));
+	flt resval;
+	int ov;
+	fa = f64_to_flt(exp_to_f64(ap), sg);
+	fb = f64_to_flt(exp_to_f64(b), sg);
+	IGNORE flt_mul(flptnos[fa], flptnos[fb], &resval);
+	/* status cannot be wrong */
+	flptnos[fa] = resval;
+	x = flt_to_f64(fa, sg, &ov);
+	if (et != f_wrap.err_code &&
+	    (ov || constovf(b) || check_size(x, sg, shape_size(sh(ap))))) {
+		setconstovf(ap);
+	}
+	if (sg && extra_checks &&
+	    (ov || (shape_size(sh(ap)) <= 32 && check_size(x, sg, 32)))) {
+		failer(MULT_OUT_OF_BOUNDS);
+		exit(EXIT_FAILURE);
+	}
-  flpt_ret(fa);
+	flpt_ret(fa);
-  flpt_ret(fb);
+	flpt_ret(fb);
-  bigres(ap, &x);
+	bigres(ap, &x);
-  return;
+	return;
 }
 /* auxiliary function used for comm_ass by and */
-static void and_fn
-    PROTO_N ( (ap, b, et) )
-    PROTO_T ( exp ap X exp b X int et )
-{
-  flt64 xa, xb;
-  UNUSED (et);
-  xa = exp_to_f64(ap);
-  xb = exp_to_f64(b);
-  xa.small &= xb.small;
-  xa.big &= xb.big;
-  bigres(ap, &xa);
-  return;
-}
-/* auxiliary function used for comm_ass by or */
-static void or_fn
+static void
-    PROTO_N ( (ap, b, et) )
-    PROTO_T ( exp ap X exp b X int et )
+and_fn(exp ap, exp b, int et)
+{
-  flt64 xa, xb;
+	flt64 xa, xb;
-  UNUSED (et);
+	UNUSED(et);
-  xa = exp_to_f64(ap);
+	xa = exp_to_f64(ap);
-  xb = exp_to_f64(b);
+	xb = exp_to_f64(b);
-  xa.small |= xb.small;
+	xa.small &= xb.small;
-  xa.big |= xb.big;
+	xa.big &= xb.big;
-  bigres(ap, &xa);
+	bigres(ap, &xa);
-  return;
+	return;
 }
-/* auxiliary function used for comm_ass by xor */
+/* auxiliary function used for comm_ass by or */
-static void xor_fn
+static void
-    PROTO_N ( (ap, b, et) )
-    PROTO_T ( exp ap X exp b X int et )
+or_fn(exp ap, exp b, int et)
+{
-  flt64 xa, xb;
+	flt64 xa, xb;
+	UNUSED(et);
+	xa = exp_to_f64(ap);
+	xb = exp_to_f64(b);
+	xa.small |= xb.small;
+	xa.big |= xb.big;
+	bigres(ap, &xa);
+	return;
+}
+/* auxiliary function used for comm_ass by xor */
+static void
+xor_fn(exp ap, exp b, int et)
+{
+	flt64 xa, xb;
-  UNUSED (et);
+	UNUSED(et);
-  xa = exp_to_f64(ap);
+	xa = exp_to_f64(ap);
-  xb = exp_to_f64(b);
+	xb = exp_to_f64(b);
-  xa.small ^= xb.small;
+	xa.small ^= xb.small;
-  xa.big ^= xb.big;
+	xa.big ^= xb.big;
-  bigres(ap, &xa);
+	bigres(ap, &xa);
-  return;
+	return;
 }
 /* not used for comm_ass */
-static void domaxmin
+static void
-    PROTO_N ( (ap, b, mx) )
-    PROTO_T ( exp ap X exp b X int mx )
+domaxmin(exp ap, exp b, int mx)
+{
-  flt64 xa, xb;
+	flt64 xa, xb;
-  int use_a;
+	int use_a;
-  xa = exp_to_f64(ap);
+	xa = exp_to_f64(ap);
-  xb = exp_to_f64(b);
+	xb = exp_to_f64(b);
-  if (is_signed(sh(ap))) {
+	if (is_signed(sh(ap))) {
-    if (xa.big > xb.big)
+		if (xa.big > xb.big) {
-      use_a = mx;
+			use_a = mx;
+		}
-    if (xa.big < xb.big)
+		if (xa.big < xb.big) {
-      use_a = !mx;
+			use_a = !mx;
+		}
-    if (xa.big == xb.big) {
+		if (xa.big == xb.big) {
-      if (xa.small >= xb.small)
+			if (xa.small >= xb.small) {
-	use_a = mx;
+				use_a = mx;
-      else
+			} else {
-	use_a = !mx;
+				use_a = !mx;
-    };
+			}
-  }
+		}
-  else {
+	} else {
-    if ((unsigned int)xa.big > (unsigned int)xb.big)
+		if ((unsigned int)xa.big > (unsigned int)xb.big) {
-      use_a = mx;
+			use_a = mx;
+		}
-    if ((unsigned int)xa.big < (unsigned int)xb.big)
+		if ((unsigned int)xa.big < (unsigned int)xb.big) {
-      use_a = !mx;
+			use_a = !mx;
+		}
-    if (xa.big == xb.big) {
+		if (xa.big == xb.big) {
-      if (xa.small >= xb.small)
+			if (xa.small >= xb.small) {
-	use_a = mx;
+				use_a = mx;
-      else
+			} else {
-	use_a = !mx;
+				use_a = !mx;
-    };
+			}
-  };
+		}
+	}
-  SET(use_a);
+	SET(use_a);
-  if (use_a)
+	if (use_a) {
-    bigres(ap, &xa);
+		bigres(ap, &xa);
-  else
+	} else {
-    bigres(ap, &xb);
+		bigres(ap, &xb);
+	}
-  return;
+	return;
+}
 /* produce allones for integer length of shape of e. */
-static int  all_ones
+static int
-    PROTO_N ( (e) )
-    PROTO_T ( exp e )
+all_ones(exp e)
 {
-  switch (shape_size(sh(e))) {
+	switch (shape_size(sh(e))) {
-    case 8:
+	case 8:
-      return (0xff);
+		return(0xff);
-    case 16:
+	case 16:
-      return (0xffff);
+		return(0xffff);
-    default:
+	default:
-      return (0xffffffff);
+		return(0xffffffff);
-  }
+	}
 }
 /* obey div1 on constants */
-static void dodiv1
+static void
-    PROTO_N ( (ap, b) )
-    PROTO_T ( exp ap X exp b )
+dodiv1(exp ap, exp b)
+{
-  flt64 x;
+	flt64 x;
-  flpt fa, fb;
-  int sg = is_signed(sh(ap));
-  flt resval;
-  int ov;
-  fa = f64_to_flt(exp_to_f64(ap), sg);
-  fb = f64_to_flt(exp_to_f64(b), sg);
-  IGNORE flt_div (flptnos[fa], flptnos[fb], &resval);
-		/* status cannot be wrong */
-  IGNORE flpt_round_to_integer((int)f_toward_smaller, &resval);
-  flptnos[fa] = resval;
-  x = flt_to_f64(fa, sg, &ov);
-  flpt_ret(fa);
-  flpt_ret(fb);
-  bigres(ap, &x);
-  return;
-}
-/* obey div2 on constants */
-static void dodiv2
-    PROTO_N ( (ap, b) )
-    PROTO_T ( exp ap X exp b )
-{
-  flt64 x;
-  flpt fa, fb;
+	flpt fa, fb;
-  int sg = is_signed(sh(ap));
+	int sg = is_signed(sh(ap));
-  flt resval;
+	flt resval;
-  int ov;
+	int ov;
-  fa = f64_to_flt(exp_to_f64(ap), sg);
-  fb = f64_to_flt(exp_to_f64(b), sg);
-  IGNORE flt_div (flptnos[fa], flptnos[fb], &resval);
-		/* status cannot be wrong */
-  IGNORE flpt_round_to_integer((int)f_toward_zero, &resval);
-  flptnos[fa] = resval;
-  x = flt_to_f64(fa, sg, &ov);
+	fa = f64_to_flt(exp_to_f64(ap), sg);
+	fb = f64_to_flt(exp_to_f64(b), sg);
+	IGNORE flt_div(flptnos[fa], flptnos[fb], &resval);
+	/* status cannot be wrong */
+	IGNORE flpt_round_to_integer((int)f_toward_smaller, &resval);
-  flpt_ret(fa);
+	flptnos[fa] = resval;
-  flpt_ret(fb);
+	x = flt_to_f64(fa, sg, &ov);
+	flpt_ret(fa);
+	flpt_ret(fb);
-  bigres(ap, &x);
+	bigres(ap, &x);
-  return;
+	return;
+}
-/* obey mod on constants */
+/* obey div2 on constants */
-static void domod
+static void
-    PROTO_N ( (ap, b) )
-    PROTO_T ( exp ap X exp b )
+dodiv2(exp ap, exp b)
+{
+	flt64 x;
+	flpt fa, fb;
+	int sg = is_signed(sh(ap));
+	flt resval;
+	int ov;
+	fa = f64_to_flt(exp_to_f64(ap), sg);
+	fb = f64_to_flt(exp_to_f64(b), sg);
+	IGNORE flt_div(flptnos[fa], flptnos[fb], &resval);
+	/* status cannot be wrong */
+	IGNORE flpt_round_to_integer((int)f_toward_zero, &resval);
+	flptnos[fa] = resval;
+	x = flt_to_f64(fa, sg, &ov);
+	flpt_ret(fa);
+	flpt_ret(fb);
+	bigres(ap, &x);
+	return;
+}
+/* obey mod on constants */
+static void
+domod(exp ap, exp b)
+{
-  exp top = copy(ap);
+	exp top = copy(ap);
-  dodiv1(top, b);
+	dodiv1(top, b);
-  mult_fn(b, top, f_wrap.err_code);
+	mult_fn(b, top, f_wrap.err_code);
-  neg_fn(b);
+	neg_fn(b);
-  plus_fn(ap, b, f_wrap.err_code);
+	plus_fn(ap, b, f_wrap.err_code);
-  return;
+	return;
 }
 /* obey rem2 on constants */
-static void dorem2
+static void
-    PROTO_N ( (ap, b) )
-    PROTO_T ( exp ap X exp b )
+dorem2(exp ap, exp b)
 {
-  exp top = copy(ap);
+	exp top = copy(ap);
-  dodiv2(top, b);
+	dodiv2(top, b);
-  mult_fn(b, top, f_wrap.err_code);
+	mult_fn(b, top, f_wrap.err_code);
-  neg_fn(b);
+	neg_fn(b);
-  plus_fn(ap, b, f_wrap.err_code);
+	plus_fn(ap, b, f_wrap.err_code);
-  return;
+	return;
+}
 /* obey shift (places signed) on constants */
-static void  doshl
+static void
-    PROTO_N ( (e) )
-    PROTO_T ( exp e )
+doshl(exp e)
 {
-  flt64 x;
+	flt64 x;
-  exp arg1 = son(e);
+	exp arg1 = son(e);
-  exp arg2 = bro(arg1);
+	exp arg2 = bro(arg1);
-  int pl = no(arg2);
+	int pl = no(arg2);
-  shape sha = sh(e);
+	shape sha = sh(e);
-  int sg = is_signed(sha);
+	int sg = is_signed(sha);
-  sh(arg1) = sh(e);
+	sh(arg1) = sh(e);
-  x = exp_to_f64(arg1);
+	x = exp_to_f64(arg1);
-  if (name(e) == shl_tag)  { /* shift left */
+	if (name(e) == shl_tag) {
+		/* shift left */
-    if (isbigval(arg2) || pl >= shape_size(sha)) {
+		if (isbigval(arg2) || pl >= shape_size(sha)) {
-      no(arg1) = 0;
+			no(arg1) = 0;
-      clearbigval(arg1);
+			clearbigval(arg1);
-      return;
+			return;
-    };
+		}
-    if (pl >= 32)  {
+		if (pl >= 32) {
-      x.big = (int)(x.small << (pl-32));
+			x.big = (int)(x.small << (pl - 32));
-      x.small = 0;
+			x.small = 0;
-    }
-    else  {
+		} else {
-      x.big <<= pl;
+			x.big <<= pl;
-      x.big |= (int)(x.small >> (32-pl));
+			x.big |= (int)(x.small >> (32 - pl));
-      x.small <<= pl;
+			x.small <<= pl;
-    };
+		}
-  }
+	} else {
-  else  {  /* shift right */
+		/* shift right */
-    if (isbigval(arg2) || pl >= shape_size(sha)) {
+		if (isbigval(arg2) || pl >= shape_size(sha)) {
-      no(arg1) = 0;
+			no(arg1) = 0;
-      if (sg) {
+			if (sg) {
-	if (isbigval(arg1)) {
+				if (isbigval(arg1)) {
-	  if (flptnos[no(arg1)].sign == -1)
+					if (flptnos[no(arg1)].sign == -1) {
-	    no(arg1) = -1;
+						no(arg1) = -1;
-	}
-	else
+					}
-	if (no(arg1) < 0)
+				} else if (no(arg1) < 0) {
-	  no(arg1) = -1;
+						no(arg1) = -1;
-      };
+				}
+			}
-      clearbigval(arg1);
+			clearbigval(arg1);
-      return;
+			return;
-    };
+		}
-    if (pl >= 32) {
+		if (pl >= 32) {
-      if (sg)  {
+			if (sg) {
-	x.small = (unsigned int)(x.big >> (pl-32));
+				x.small = (unsigned int)(x.big >> (pl - 32));
-	x.big = x.big >> 31;
+				x.big = x.big >> 31;
-      }
-      else {
+			} else {
-	x.small = ((unsigned int)x.big) >> (pl-32);
+				x.small = ((unsigned int)x.big) >> (pl - 32);
-	x.big = 0;
+				x.big = 0;
-      };
-    }
+			}
-    else  {
+		} else {
-      if (sg)  {
+			if (sg) {
-	x.small >>= pl;
+				x.small >>= pl;
-	x.small |= (unsigned int)(x.big << (32-pl));
+				x.small |= (unsigned int)(x.big << (32 - pl));
-	x.big >>= pl;
+				x.big >>= pl;
-      }
-      else {
+			} else {
-	x.small >>= pl;
+				x.small >>= pl;
-	x.small |= (unsigned int)(x.big << (32-pl));
+				x.small |= (unsigned int)(x.big << (32 - pl));
-	x.big = (int)(((unsigned int)x.big) >> pl);
+				x.big = (int)(((unsigned int)x.big) >> pl);
-      };
+			}
-    };
+		}
-  };
+	}
-  bigres(arg1, &x);
+	bigres(arg1, &x);
-  return;
+	return;
 }
 #if has_setcc
  /* included if target has a setcc operation, to set a bit from the
     condition flags */
-static exp absbool
+static exp
-    PROTO_N ( (id) )
-    PROTO_T ( exp id )
+absbool(exp id)
+{
-				/* check if e  is (let a = 0 in
-				   cond(test(L)=result; a=1 | L:top); a )
+	/* check if e is (let a = 0 in cond(test(L) = result; a = 1 | L:top); a)
-				   If so, return the test, otherwise
+	   If so, return the test, otherwise nilexp. */
-				   nilexp. */
-  if (isvar (id) && name (son (id)) == val_tag && no (son (id)) == 0 &&
+	if (isvar(id) && name(son(id)) == val_tag && no(son(id)) == 0 &&
-	!isbigval(son(id))
-      && no (id) == 2) {
+	    !isbigval(son(id)) && no(id) == 2) {
-	/* name initially 0 only used twice */
+		/* name initially 0 only used twice */
-    exp bdy = bro (son (id));
+		exp bdy = bro(son(id));
-    if (name (bdy) == seq_tag && name (bro (son (bdy))) == cont_tag &&
+		if (name(bdy) == seq_tag && name(bro(son(bdy))) == cont_tag &&
-	name (son (bro (son (bdy)))) == name_tag &&
+		    name(son(bro(son(bdy)))) == name_tag &&
-	son (son (bro (son (bdy)))) == id) {
+		    son(son(bro(son(bdy)))) == id) {
-	/* one use is result  of sequence body */
+			/* one use is result of sequence body */
-      exp c = son (son (bdy));
+			exp c = son(son(bdy));
 #ifndef NEWDIAGS
-      if (name(c) == diagnose_tag)
+			if (name(c) == diagnose_tag) {
-        c = son(c);
+				c = son(c);
+			}
 #endif
-      if (last (c) && name (c) == cond_tag) {
+			if (last(c) && name(c) == cond_tag) {
-	/* seq is cond=c; id */
+				/* seq is cond=c; id */
-	exp first = son (c);
+				exp first = son(c);
-	exp second = bro (son (c));
+				exp second = bro(son(c));
-	if (no (son (second)) == 1 /* only one jump to else */ &&
+				/* only one jump to else */
+				if (no(son(second)) == 1 &&
-	    name (bro (son (second))) == top_tag
+				    name(bro(son(second))) == top_tag &&
-	    && name (first) == seq_tag) {
+				    name(first) == seq_tag) {
-	  /* cond is (seq= first | L: top) */
+					/* cond is (seq = first | L: top) */
-	  exp s = son (son (first));
+					exp s = son(son(first));
-	  exp r = bro (son (first));
+					exp r = bro(son(first));
+					/* last of seq is id = 1 */
+					/* start of seq is int test jumping to
+					 * second */
+					if (name(r) == ass_tag &&
-	  if (name (r) == ass_tag && name (son (r)) == name_tag &&
+					    name(son(r)) == name_tag &&
+					    son(son(r)) == id &&
-	      son (son (r)) == id && name (bro (son (r))) == val_tag &&
+					    name(bro(son(r))) == val_tag &&
-		!isbigval(bro(son(r))) &&
+					    !isbigval(bro(son(r))) &&
-	      no (bro (son (r))) == 1 /* last of seq is id = 1 */ &&
+					    no(bro(son(r))) == 1 &&
-	      last (s) && name (s) == test_tag && pt (s) == second
+					    last(s) && name(s) == test_tag &&
-	  /* start of seq is int test jumping to second */
+					    pt(s) == second) {
-	    )
-	    return s;
+						return s;
+					}
-	} /* cond is (seq= first | L: top) */
+				} /* cond is (seq= first | L: top) */
-      }; /* seq is cond=c; id */
+			} /* seq is cond=c; id */
-      if (last(c) && name(c) == condassign_tag) {
+			if (last(c) && name(c) == condassign_tag) {
-	/* seq is condassign = c; id */
+				/* seq is condassign = c; id */
-	exp s = son (c);
+				exp s = son(c);
-	exp r = bro (s);
+				exp r = bro(s);
+				/* last of seq is id = 1 */
-	if (name (son (r)) == name_tag &&
+				if (name(son(r)) == name_tag &&
+				    son(son(r)) == id &&
-		son (son (r)) == id && name (bro (son (r))) == val_tag &&
+				    name(bro(son(r))) == val_tag &&
-		!isbigval(bro(son(r))) &&
+				    !isbigval(bro(son(r))) &&
-	      no (bro (son (r))) == 1 /* last of seq is id = 1 */)
+				    no(bro(son(r))) == 1) {
-	  return s;
+					return s;
+				}
-      }; /* seq is condassign = c; id */
+			} /* seq is condassign = c; id */
-    } /* one use is result  of sequence body */
+		} /* one use is result of sequence body */
-  } /* name initially 0 only used twice */
+	} /* name initially 0 only used twice */
-  return nilexp;
+	return nilexp;
 }
 #endif
  /* distributes the operation e into a sequence, ie if e = op(seq(d ...;
-    c), a) produces seq(d...; op(c,a))  */
+    c), a) produces seq(d...; op(c, a)) */
-static int seq_distr
+static int
-    PROTO_N ( (e, scope) )
-    PROTO_T ( exp e X exp scope )
+seq_distr(exp e, exp scope)
+{
-  exp x = son(e);
+	exp x = son(e);
-  exp y;
+	exp y;
-  if (last(x) || (!last(x) && last(bro(x)))) {
+	if (last(x) || (!last(x) && last(bro(x)))) {
-    if (name(x) == seq_tag || name(x) == ident_tag) {
+		if (name(x) == seq_tag || name(x) == ident_tag) {
-      exp b = bro(son(x));
+			exp b = bro(son(x));
-      exp r;
+			exp r;
-      if (name(x) == ident_tag) { clearinlined(x); }
+			if (name(x) == ident_tag) {
-      if (last(x))
+				clearinlined(x);
-	r = me_u3(sh(e), copy(b), name(e));
-      else {
+			}
-#ifdef NEWDIAGS
-	if (diagnose)
+			if (last(x)) {
-	  dg_restruct_code (x, bro(x), +1);
-#endif
-	r = me_b3(sh(e), copy(b), bro(x), name(e));
+				r = me_u3(sh(e), copy(b), name(e));
-      }
+			} else {
-      pt(r) = pt(e);
-      no(r) = no(e);
-      props(r) = props(e);
-      r = hold_check(r);
-      sh(x) = sh(e);
-      replace(b, r, r);		/* dgf preserved in copy */
-      kill_exp(b, b);
 #ifdef NEWDIAGS
-      if (diagnose)
+				if (diagnose) {
-	dg_whole_comp (e, x);
+					dg_restruct_code(x, bro(x), +1);
+				}
 #endif
+				r = me_b3(sh(e), copy(b), bro(x), name(e));
+			}
+			pt(r) = pt(e);
+			no(r) = no(e);
+			props(r) = props(e);
+			r = hold_check(r);
+			sh(x) = sh(e);
+			replace(b, r, r);	/* dgf preserved in copy */
+			kill_exp(b, b);
+#ifdef NEWDIAGS
+			if (diagnose) {
+				dg_whole_comp(e, x);
+			}
+#endif
-      replace(e, x, scope);
+			replace(e, x, scope);
-      return 1;
+			return 1;
-    };
+		}
-  };
+	}
-  if (!last(x) && last(bro(x))) {
+	if (!last(x) && last(bro(x))) {
-    y = bro(x);
+		y = bro(x);
-    if (name(y) == seq_tag || name(y) == ident_tag) {
+		if (name(y) == seq_tag || name(y) == ident_tag) {
-      exp b = bro(son(y));
+			exp b = bro(son(y));
-      exp r;
+			exp r;
-      if (name(y) == ident_tag) { clearinlined(y); }
+			if (name(y) == ident_tag) {
+				clearinlined(y);
+			}
+#ifdef NEWDIAGS
+			if (diagnose) {
+				dg_restruct_code(y, x, -1);
+			}
+#endif
+			r = me_b3(sh(e), x, copy(b), name(e));
+			pt(r) = pt(e);
+			no(r) = no(e);
+			props(r) = props(e);
+			r = hold_check(r);
+			sh(y) = sh(e);
+			replace(b, r, r);		/* dgf preserved in copy */
+			kill_exp(b, b);
 #ifdef NEWDIAGS
-      if (diagnose)
+			if (diagnose) {
-	dg_restruct_code (y, x, -1);
+				dg_whole_comp(e, y);
+			}
 #endif
-      r = me_b3(sh(e), x, copy(b), name(e));
-      pt(r) = pt(e);
-      no(r) = no(e);
-      props(r) = props(e);
-      r = hold_check(r);
-      sh(y) = sh(e);
-      replace(b, r, r);		/* dgf preserved in copy */
-      kill_exp(b, b);
-#ifdef NEWDIAGS
-      if (diagnose)
-	dg_whole_comp (e, y);
-#endif
-      replace(e, y, scope);
+			replace(e, y, scope);
-      return 1;
+			return 1;
-    };
+		}
-  };
+	}
-  return 0;
+	return 0;
+}
  /* reverses (ie. nots) test numbers */
-unsigned char  revtest[6] = {
+unsigned char revtest[6] = {
 , 3, 2, 1, 6, 5
 };
 /* returns sign if |f|=1, otherwise 0 */
-static int  f_one
-    PROTO_N ( (f) )
-    PROTO_T ( flpt f )
-{
-  flt fconst;
-  fconst = flptnos[f];
-  if (fconst.mant[0] == 1 && fconst.exp == 0) {
-    int   i = 1;
-    while (i < MANT_SIZE && fconst.mant[i] == 0)
-      ++i;
-    if (i == MANT_SIZE)
-      return (fconst.sign);
-    else
-      return (0);
-  }
-  else
-    return (0);
-}
-/* applies fneg */
-static  exp fneg
+static int
-    PROTO_N ( (e) )
+f_one(flpt f)
-    PROTO_T ( exp e )
+{
+	flt fconst;
+	fconst = flptnos[f];
+	if (fconst.mant[0] == 1 && fconst.exp == 0) {
+		int i = 1;
+		while (i < MANT_SIZE && fconst.mant[i] == 0) {
+			++i;
+		}
+		if (i == MANT_SIZE) {
+			return(fconst.sign);
+		} else {
+			return(0);
+		}
+	} else {
+		return(0);
+	}
+}
+/* applies fneg */
+static exp
+fneg(exp e)
+{
-  exp n = getexp (sh (e), nilexp, 0, e, nilexp, 0, 0, fneg_tag);
+	exp n = getexp(sh(e), nilexp, 0, e, nilexp, 0, 0, fneg_tag);
-  setlast (e);
+	setlast(e);
-  bro (e) = n;
+	bro(e) = n;
-  return (n);
+	return(n);
 }
 /* applies binary floating point operations */
-static  int check_fp2
-    PROTO_N ( (e, scope) )
-    PROTO_T ( exp e X exp scope )
-{
-  exp a1 = son (e);
-  exp a2 = bro (a1);
-  flpt f1, f2;
-  flt resval;
-  int   status;
+	}
-    }
-  };
-  return (0);
+	return(0);
-}
-/* compares integer constants using the test given by test_no */
-static int docmp
-    PROTO_N ( (sha, test_no, c1, c2) )
-    PROTO_T ( shape sha X unsigned char test_no X int c1 X int c2 )
-{
-  int c;
-  switch (shape_size(sha)) EXHAUSTIVE {
-    case 8:
-     if (is_signed(sha))
-      {
-	int   d1 = (c1 & 0x80) ? (c1 | ~0x7f) : (c1 & 0xff);
-	int   d2 = (c2 & 0x80) ? (c2 | ~0x7f) : (c2 & 0xff);
-	switch (test_no) EXHAUSTIVE {
-	  case 1:
-	    c = (d1 > d2);
-	    break;
-	  case 2:
-	    c = (d1 >= d2);
-	    break;
-	  case 3:
-	    c = (d1 < d2);
-	    break;
-	  case 4:
-	    c = (d1 <= d2);
-	    break;
-	  case 5:
-	    c = (d1 == d2);
-	    break;
-	  case 6:
-	    c = (d1 != d2);
-	    break;
-	};
-	break;
-      }
-      else
-      {
-	unsigned char d1 = (unsigned char)(c1 & 0xff);
-	unsigned char d2 = (unsigned char)(c2 & 0xff);
-	switch (test_no) EXHAUSTIVE {
-	  case 1:
-	    c = (d1 > d2);
-	    break;
-	  case 2:
-	    c = (d1 >= d2);
-	    break;
-	  case 3:
-	    c = (d1 < d2);
-	    break;
-	  case 4:
-	    c = (d1 <= d2);
-	    break;
-	  case 5:
-	    c = (d1 == d2);
-	    break;
-	  case 6:
-	    c = (d1 != d2);
-	    break;
-	};
-	break;
-      };
-    case 16:
-     if (is_signed(sha))
-      {
-	int   d1 = (c1 & 0x8000) ? (c1 | ~0x7fff) : (c1 & 0xffff);
-	int   d2 = (c2 & 0x8000) ? (c2 | ~0x7fff) : (c2 & 0xffff);
-	switch (test_no) EXHAUSTIVE {
-	  case 1:
-	    c = (d1 > d2);
-	    break;
-	  case 2:
-	    c = (d1 >= d2);
-	    break;
-	  case 3:
-	    c = (d1 < d2);
-	    break;
-	  case 4:
-	    c = (d1 <= d2);
-	    break;
-	  case 5:
-	    c = (d1 == d2);
-	    break;
-	  case 6:
-	    c = (d1 != d2);
-	    break;
-	};
-	break;
-      }
-     else
-      {
-	unsigned short  d1 = (unsigned short)(c1 & 0xffff);
-	unsigned short  d2 = (unsigned short)(c2 & 0xffff);
-	switch (test_no) EXHAUSTIVE {
-	  case 1:
-	    c = (d1 > d2);
-	    break;
-	  case 2:
-	    c = (d1 >= d2);
-	    break;
-	  case 3:
-	    c = (d1 < d2);
-	    break;
-	  case 4:
-	    c = (d1 <= d2);
-	    break;
-	  case 5:
-	    c = (d1 == d2);
-	    break;
-	  case 6:
-	    c = (d1 != d2);
-	    break;
-	};
-	break;
-      };
-    case 32:
-     if (is_signed(sha))
-      {
-	int  d1 = c1;
-	int  d2 = c2;
-	switch (test_no) EXHAUSTIVE {
-	  case 1:
-	    c = (d1 > d2);
-	    break;
-	  case 2:
-	    c = (d1 >= d2);
-	    break;
-	  case 3:
-	    c = (d1 < d2);
-	    break;
-	  case 4:
-	    c = (d1 <= d2);
-	    break;
-	  case 5:
-	    c = (d1 == d2);
-	    break;
-	  case 6:
-	    c = (d1 != d2);
-	    break;
-	};
-	break;
-      }
-     else
-      {
-	unsigned int d1 = (unsigned int)c1;
-	unsigned int d2 = (unsigned int)c2;
-	switch (test_no) EXHAUSTIVE {
-	  case 1:
-	    c = (d1 > d2);
-	    break;
-	  case 2:
-	    c = (d1 >= d2);
-	    break;
-	  case 3:
-	    c = (d1 < d2);
-	    break;
-	  case 4:
-	    c = (d1 <= d2);
-	    break;
-	  case 5:
-	    c = (d1 == d2);
-	    break;
-	  case 6:
-	    c = (d1 != d2);
-	    break;
-	};
-	break;
-      };
-  };
-  return (c);
+}
-int docmp_f
-    PROTO_N ( (test_no, a, b) )
-    PROTO_T ( int test_no X exp a X exp b )
-{
-  shape sha = sh(a);
-  flt64 xa, xb;
-  int sg = is_signed(sha);
-  int eq = 0;
-  int less = 0;
-  int gr = 0;
-  int c;
-  if (shape_size(sh(a)) <= 32)
-    return docmp(sha, (unsigned char)test_no, no(a), no(b));
+/* compares integer constants using the test given by test_no */
-  xa = exp_to_f64(a);
-  xb = exp_to_f64(b);
-  if (xa.big == xb.big && xa.small == xb.small)
-    eq = 1;
-  if (sg && !eq) {
-    if (xa.big < xb.big)
-      less = 1;
-    else
-    if (xa.big > xb.big)
-      gr = 1;
-    else {
-      if (xa.small < xb.small)
-	less = 1;
-      else
-	gr = 1;
-    };
-  }
-  else
-  if (!eq) {
-    if ((unsigned int)xa.big < (unsigned int)xb.big)
-      less = 1;
-    else
-    if ((unsigned int)xa.big > (unsigned int)xb.big)
-      gr = 1;
-    else {
-      if (xa.small < xb.small)
-	less = 1;
-      else
-	gr = 1;
-    };
-  };
-  switch (test_no) EXHAUSTIVE {
-	  case 1:
-	    c = gr;
-	    break;
-	  case 2:
-	    c = gr | eq;
-	    break;
-	  case 3:
-	    c = less;
-	    break;
-	  case 4:
-	    c = less | eq;
-	    break;
-	  case 5:
-	    c = eq;
-	    break;
-	  case 6:
-	    c = !eq;
-	    break;
-  };
-  return c;
-}
+static int
+docmp(shape sha, unsigned char test_no, int c1, int c2)
+{
+	int c;
+	switch (shape_size(sha))EXHAUSTIVE {
+	case 8:
+		if (is_signed(sha)) {
+			int d1 = (c1 & 0x80) ? (c1 | ~0x7f) : (c1 & 0xff);
+			int d2 = (c2 & 0x80) ? (c2 | ~0x7f) : (c2 & 0xff);
+			switch (test_no)EXHAUSTIVE {
+			case 1:
+				c = (d1 > d2);
+				break;
+			case 2:
+				c = (d1 >= d2);
+				break;
+			case 3:
+				c = (d1 < d2);
+				break;
+			case 4:
+				c = (d1 <= d2);
+				break;
+			case 5:
+				c = (d1 == d2);
+				break;
+			case 6:
+				c = (d1 != d2);
+				break;
+			}
+			break;
+		} else {
+			unsigned char d1 = (unsigned char)(c1 & 0xff);
+			unsigned char d2 = (unsigned char)(c2 & 0xff);
+			switch (test_no)EXHAUSTIVE {
+			case 1:
+				c = (d1 > d2);
+				break;
+			case 2:
+				c = (d1 >= d2);
+				break;
+			case 3:
+				c = (d1 < d2);
+				break;
+			case 4:
+				c = (d1 <= d2);
+				break;
+			case 5:
+				c = (d1 == d2);
+				break;
+			case 6:
+				c = (d1 != d2);
+				break;
+			}
+			break;
+		}
+	case 16:
+		if (is_signed(sha)) {
+			int d1 = (c1 & 0x8000) ? (c1 | ~0x7fff) : (c1 & 0xffff);
+			int d2 = (c2 & 0x8000) ? (c2 | ~0x7fff) : (c2 & 0xffff);
+			switch (test_no)EXHAUSTIVE {
+			case 1:
+				c = (d1 > d2);
+				break;
+			case 2:
+				c = (d1 >= d2);
+				break;
+			case 3:
+				c = (d1 < d2);
+				break;
+			case 4:
+				c = (d1 <= d2);
+				break;
+			case 5:
+				c = (d1 == d2);
+				break;
+			case 6:
+				c = (d1 != d2);
+				break;
+			}
+			break;
+		} else {
+			unsigned short d1 = (unsigned short)(c1 & 0xffff);
+			unsigned short d2 = (unsigned short)(c2 & 0xffff);
+			switch (test_no)EXHAUSTIVE {
+			case 1:
+				c = (d1 > d2);
+				break;
+			case 2:
+				c = (d1 >= d2);
+				break;
+			case 3:
+				c = (d1 < d2);
+				break;
+			case 4:
+				c = (d1 <= d2);
+				break;
+			case 5:
+				c = (d1 == d2);
+				break;
+			case 6:
+				c = (d1 != d2);
+				break;
+			}
+			break;
+		}
+	case 32:
+		if (is_signed(sha)) {
+			int d1 = c1;
+			int d2 = c2;
+			switch (test_no)EXHAUSTIVE {
+			case 1:
+				c = (d1 > d2);
+				break;
+			case 2:
+				c = (d1 >= d2);
+				break;
+			case 3:
+				c = (d1 < d2);
+				break;
+			case 4:
+				c = (d1 <= d2);
+				break;
+			case 5:
+				c = (d1 == d2);
+				break;
+			case 6:
+				c = (d1 != d2);
+				break;
+			}
+			break;
+		} else {
+			unsigned int d1 = (unsigned int)c1;
+			unsigned int d2 = (unsigned int)c2;
+			switch (test_no)EXHAUSTIVE {
+			case 1:
+				c = (d1 > d2);
+				break;
+			case 2:
+				c = (d1 >= d2);
+				break;
+			case 3:
+				c = (d1 < d2);
+				break;
+			case 4:
+				c = (d1 <= d2);
+				break;
+			case 5:
+				c = (d1 == d2);
+				break;
+			case 6:
+				c = (d1 != d2);
+				break;
+			}
+			break;
+		}
+	}
+	return(c);
+}
+int
+docmp_f(int test_no, exp a, exp b)
+{
+	shape sha = sh(a);
+	flt64 xa, xb;
+	int sg = is_signed(sha);
+	int eq = 0;
+	int less = 0;
+	int gr = 0;
+	int c;
+	if (shape_size(sh(a)) <= 32) {
+		return docmp(sha, (unsigned char)test_no, no(a), no(b));
+	}
+	xa = exp_to_f64(a);
+	xb = exp_to_f64(b);
+	if (xa.big == xb.big && xa.small == xb.small) {
+		eq = 1;
+	}
+	if (sg && !eq) {
+		if (xa.big < xb.big) {
+			less = 1;
+		} else if (xa.big > xb.big) {
+			gr = 1;
+		} else {
+			if (xa.small < xb.small) {
+				less = 1;
+			} else {
+				gr = 1;
+			}
+		}
+	} else if (!eq) {
+		if ((unsigned int)xa.big < (unsigned int)xb.big) {
+			less = 1;
+		} else if ((unsigned int)xa.big > (unsigned int)xb.big) {
+			gr = 1;
+		} else {
+			if (xa.small < xb.small) {
+				less = 1;
+			} else {
+				gr = 1;
+			}
+		}
+	}
+	switch (test_no)EXHAUSTIVE {
+	case 1:
+		c = gr;
+		break;
+	case 2:
+		c = gr | eq;
+		break;
+	case 3:
+		c = less;
+		break;
+	case 4:
+		c = less | eq;
+		break;
+	case 5:
+		c = eq;
+		break;
+	case 6:
+		c = !eq;
+		break;
+	}
+	return c;
+}
-/* main bottom-to-top optimise routine
+/* main bottom-to-top optimise routine Optimises e. No change propagates
-   Optimises e. No change propagates
    outside scope */
-int check
-    PROTO_N ( (e, scope) )
-    PROTO_T ( exp e X exp scope )
-{
-  if (is_a (name (e))) {/* main op non-side effect */
-    unsigned char n = name(e);
-    if (son(e) != nilexp && n != name_tag && n != env_offset_tag &&
-	n != general_env_offset_tag &&
-	n != proc_tag && n != general_proc_tag) {
-      exp temp = son(e);
-      while (1) {
-        if (name(sh(temp)) == bothd) {
-		/* unordered; temp can be first, iwc all siblings unreachable */
-#ifdef NEWDIAGS
-	  if (diagnose) {
-	    exp sib = son(e);
-	    for (;;) {
-	      if (sib != temp)
-		dg_dead_code (sib, temp);
-	      if (last(sib))
-		break;
-	      sib = bro(sib);
-	    }
-	    dg_whole_comp (e, temp);
-	  }
-#endif
-	  replace(e, temp, scope);
-	  retcell(e);
-	  return 1;
-        };
-        if (last(temp))
-	  break;
-        temp = bro(temp);
-      }
-    }
-    switch (name (e)) {
-      case component_tag:
-        {
-          exp v = son(e);
-          exp a = bro(v);
-          if (name(a) == val_tag)
-            {
-             exp res;
-             if (no(a) == 0 && shape_size(sh(v)) == shape_size(sh(e))
-#if dont_unpad_apply
-                     && name(v) != apply_tag
-#endif
-                            ) { /* remove the operation if the offset
-                                     is zero and the size is the same.
-                                     This typically happens in selecting
-                                     from a union if the component has
-                                     the maximum size in the union */
-                 sh(v) = sh(e);
-#ifdef NEWDIAGS
-		 if (diagnose)
-		   dg_whole_comp (e, v);
-#endif
-                 replace(e, v, scope);
-                 retcell(a);
-                 retcell(e);
-                 return 1;
-               };
 #ifdef NEWDIAGS
-	    if (diagnose)
+					if (diagnose) {
-	      dg_whole_comp (e, son(e));
+						dg_whole_comp(e, son(e));
+					}
 #endif
-	    replace (e, son (e), scope);
+					replace(e, son(e), scope);
-	    retcell (e);
+					retcell(e);
-	    return (1);
+					return(1);
-	  };
+				};
-	  return 0;
+				return 0;
-	};
-      case offset_max_tag:
+		case offset_max_tag:
-	{
-	  if (name (son (e)) == val_tag &&
+				if (name(son(e)) == val_tag &&
-	      name (bro (son (e))) == val_tag &&
+				    name(bro(son(e))) == val_tag &&
+				    !isbigval(son(e)) &&
-		!isbigval(son(e)) && !isbigval(bro(son(e)))) {
+				    !isbigval(bro(son(e)))) {
-	    /* both arguments constant */
+					/* both arguments constant */
-            int n1 = no(son(e));
+					int n1 = no(son(e));
-            int n2 = no(bro(son(e)));
+					int n2 = no(bro(son(e)));
-	    no (son (e)) = (n1 > n2) ? n1 : n2;
+					no(son(e)) = (n1 > n2)? n1 : n2;
-	    sh (son (e)) = sh (e);
+					sh(son(e)) = sh(e);
-	    retcell (bro (son (e)));
+					retcell(bro(son(e)));
-	    replace (e, son (e), scope);
+					replace(e, son(e), scope);
-	    retcell (e);
+					retcell(e);
-	    return (1);
+					return(1);
-	  };
+				}
-	  return 0;
+				return 0;
-	};
-      case offset_mult_tag:
+		case offset_mult_tag:
-	{
-	  if (name (son (e)) == val_tag &&
+				if (name(son(e)) == val_tag &&
-	      name (bro (son (e))) == val_tag &&
+				    name(bro(son(e))) == val_tag &&
+				    !isbigval(son(e)) &&
-		!isbigval(son(e)) && !isbigval(bro(son(e)))) {
+				    !isbigval(bro(son(e)))) {
-	    /* both arguments constant */
+					/* both arguments constant */
-            int n1 = no(son(e));
+					int n1 = no(son(e));
-            int n2 = no(bro(son(e)));
+					int n2 = no(bro(son(e)));
-	    no (son (e)) = n1 * n2;
+					no(son(e)) = n1 * n2;
-	    sh (son (e)) = sh (e);
+					sh(son(e)) = sh(e);
-	    retcell (bro (son (e)));
+					retcell(bro(son(e)));
-	    replace (e, son (e), scope);
+					replace(e, son(e), scope);
-	    retcell (e);
+					retcell(e);
-	    return (1);
+					return(1);
-	  };
+				}
-          if (name(son(e)) == val_tag && !isbigval(son(e))&&
+				if (name(son(e)) == val_tag &&
+				    !isbigval(son(e)) &&
-		 no(son(e)) == 1)
+				    no(son(e)) == 1) {
-            {  /* multiply by 1 */
+					/* multiply by 1 */
-              sh(bro(son(e))) = sh(e);
+					sh(bro(son(e))) = sh(e);
-              replace(e, bro(son(e)), scope);
+					replace(e, bro(son(e)), scope);
-              retcell(e);
+					retcell(e);
-              return (1);
+					return(1);
-            };
+				}
+				if (name(son(e)) == val_tag &&
-          if (name(son(e)) == val_tag && !isbigval(son(e)) &&					no(son(e)) == 0)
+				    !isbigval(son(e)) && no(son(e)) == 0) {
-            {  /* multiply by 0 - replace by sequence - side-effects!*/
+					/* multiply by 0 - replace by sequence
+					 * - side-effects!*/
-	      exp_list el;
+					exp_list el;
-	      el.start = bro(son(e));
+					el.start = bro(son(e));
-	      el.end = bro(son(e));
+					el.end = bro(son(e));
-	      el.number = 1;
+					el.number = 1;
-              sh(son(e)) = sh(e);
+					sh(son(e)) = sh(e);
-              replace(e, f_sequence(el, son(e)), scope);
+					replace(e, f_sequence(el, son(e)),
+						scope);
-              retcell(e);
+					retcell(e);
-              return (1);
+					return(1);
+				}
+				if (name(bro(son(e))) == val_tag &&
+				    name(son(e)) == plus_tag) {
+					/* distribute offset_mult over plus
+					 * (giving offset_adds) */
+					/* the plus operation */
+					exp pl = son(e);
+					/* the offset constant */
+					exp b = bro(pl);
+					/* the first plus operand */
+					exp x = son(pl);
+					exp bx = bro(x);
+					exp res = hold_check(me_b3(sh(e), x,
+						  copy(b), offset_mult_tag));
+					exp temp;
+					while (bx != pl) {
-            };
+						x = bx;
+						bx = bro(x);
+						temp = hold_check(me_b3(sh(e),
+							x, copy(b),
+							offset_mult_tag));
+						res = hold_check(me_b3(sh(e),
+							res, temp,
+							offset_add_tag));
+					}
+					retcell(b);
+					replace(e, res, scope);
+					retcell(e);
+					return 1;
+				}
+				return 0;
+		case offset_div_by_int_tag:
+		case offset_div_tag:
+				if (name(son(e)) == val_tag &&
+				    name(bro(son(e))) == val_tag &&
+				    !isbigval(son(e)) &&
+				    !isbigval(bro(son(e)))) {
+					/* both arguments constant */
+					int n1 = no(son(e));
+					int n2 = no(bro(son(e)));
+					no(son(e)) = n1 / n2;
+					sh(son(e)) = sh(e);
+					retcell(bro(son(e)));
+					replace(e, son(e), scope);
+					retcell(e);
+					return(1);
+				}
+				return 0;
-          if (name(bro(son(e))) == val_tag &&
-               name(son(e)) == plus_tag)
-            {  /* distribute offset_mult over plus (giving
-                  offset_adds) */
-              exp pl = son(e);  /* the plus operation */
-              exp b = bro(pl);  /* the offset constant */
-              exp x = son(pl);  /* the first plus operand */
-	      exp bx = bro(x);
-              exp res = hold_check(me_b3(sh(e), x, copy(b),
-					 offset_mult_tag));
-	      exp temp;
-	      while (bx != pl) {
-		x = bx;
-	        bx = bro(x);
-		temp = hold_check(me_b3(sh(e), x, copy(b),
-					 offset_mult_tag));
-		res = hold_check(me_b3(sh(e), res, temp, offset_add_tag));
-	      };
-	      retcell(b);
-              replace(e, res, scope);
-              retcell(e);
-              return 1;
-            };
-	  return 0;
-	};
-      case offset_div_by_int_tag:
-      case offset_div_tag:
-	{
-	  if (name (son (e)) == val_tag &&
-	      name (bro (son (e))) == val_tag &&
-		!isbigval(son(e)) && !isbigval(bro(son(e)))) {
-	    /* both arguments constant */
-            int n1 = no(son(e));
-            int n2 = no(bro(son(e)));
-	    no (son (e)) = n1 / n2;
-	    sh (son (e)) = sh (e);
-	    retcell (bro (son (e)));
-	    replace (e, son (e), scope);
-	    retcell (e);
-	    return (1);
-	  };
-	  return 0;
-	};
 #if has_setcc
 #if isAlpha
-	{ exp ptr = son(e);
+				{ exp ptr = son(e);
-	  exp off = bro(ptr);
+					exp off = bro(ptr);
-	  if ((al1_of(sh(off))->al.al_val.al_frame & 4) != 0 &&
+					if ((al1_of(sh(off))->al.al_val.al_frame & 4) != 0 &&
-		!is_floating(al2_of(sh(off))->al.sh_hd)) {
+					    !is_floating(al2_of(sh(off))->al.sh_hd)) {
-		exp r = getexp (sh(ptr), off, 0, ptr, nilexp,
+						exp r = getexp(sh(ptr), off, 0,
+							       ptr, nilexp, 0,
-, 6*64, reff_tag);
+*64, reff_tag);
+						sh(off) =
+						    f_offset(al1_of(sh(off)),
-		sh(off) = f_offset(al1_of(sh(off)), long_to_al(al2(sh(off))));
+						    long_to_al(al2(sh(off))));
+						bro(ptr) =r;
-		bro(ptr)=r; setlast(ptr);
+						setlast(ptr);
-		son(e) = r;
+						son(e) = r;
-	  }
+					}
-	}
+				}
 #endif
-	  if (name (bro (son (e))) == val_tag &&
+				if (name(bro(son(e))) == val_tag &&
-		 !isbigval(bro (son (e)))) {
+				    !isbigval(bro(son(e)))) {
-	    /* replace addptr(x, const) by refffield operation */
+					/* replace addptr(x, const) by
+					 * refffield operation */
-	    exp p = son (e);
+					exp p = son(e);
-	    int  k = no (bro (p));
+					int k = no(bro(p));
-	    exp r;
+					exp r;
-	    r = getexp (sh (e), nilexp, 0, p, nilexp,
+					r = getexp(sh(e), nilexp, 0, p, nilexp,
 , k, reff_tag);
 #ifdef NEWDIAGS
-	    dgf(r) = dgf(e);
+					dgf(r) = dgf(e);
 #endif
-	    replace (e, hc (r, p), scope);
+					replace(e, hc(r, p), scope);
-	    retcell (e);
+					retcell(e);
-	    return (1);
+					return(1);
-	  };
+				}
-	  if (name (son (e)) == reff_tag &&
+				if (name(son(e)) == reff_tag &&
-                shape_size(sh(e)) == 32) {
+				    shape_size(sh(e)) == 32) {
-	    /* replace addptr(reff[n](a), b) by reff[n](addptr(a, b)) */
+					/* replace addptr(reff[n](a), b) by
+					 * reff[n](addptr(a, b)) */
-	    exp p = son (son (e));
+					exp p = son(son(e));
-	    exp a = bro (son (e));
+					exp a = bro(son(e));
-	    exp ap1 = getexp (sh (e), nilexp, 0, p, nilexp,
+					exp ap1 = getexp(sh(e), nilexp, 0, p,
+							 nilexp, 0, 0,
-, 0, addptr_tag);
+							 addptr_tag);
-	    exp ap, r;
+					exp ap, r;
-	    bro (p) = a;
+					bro(p) = a;
-	    clearlast (p);
+					clearlast(p);
-#if NEWDIAGS
-	    if (diagnose)
-	      dg_whole_comp (son(e), p);
-#endif
-	    ap = hc (ap1, a);
-	    r = hc (getexp (sh (e), nilexp, 0, ap, nilexp,
-, no (son (e)), reff_tag),
-		   ap);
 #if NEWDIAGS
-	    if (diagnose)
+					if (diagnose) {
-	      dg_whole_comp (e, r);
+						dg_whole_comp(son(e), p);
+					}
 #endif
-	    replace (e, r, scope);
-	    retcell (son (e));
-	    retcell (e);
+					ap = hc(ap1, a);
-	    return (1);
-	  };
-          if (name(bro(son(e))) == offset_add_tag)
+					r = hc(getexp(sh(e), nilexp, 0, ap,
-           {
-             exp p = son(e);
+						      nilexp, 0, no(son(e)),
-             exp a = son(bro(p));
-             exp c = bro(a);
-             if (name(c) == val_tag && !isbigval(c)) {
-               exp ap =
-                 hold_check(me_b3(f_pointer(long_to_al(al2(sh(a)))),
-                                   p, a, addptr_tag));
-               exp r = getexp(sh(e), nilexp, 0, ap, nilexp, 0,
-                             no(c), reff_tag);
-               setfather(r, ap);
+						      reff_tag), ap);
-#ifdef NEWDIAGS
-	       dgf(r) = dgf(e);
-#endif
-               replace(e, hold_check(r), scope);
-               retcell(e);
-               return 1;
-	     };
-	     if (al1(sh(p)) == al2(sh(c)))  {
-	       exp inner, outer;
-	       inner = hold_check(me_b3(sh(e), p, a, addptr_tag));
-#ifdef NEWDIAGS
-	       if (diagnose)
-		 dg_whole_comp (bro(p), inner);
-#endif
-	       outer = hold_check(me_b3(sh(e), inner, c, addptr_tag));
-#ifdef NEWDIAGS
+#if NEWDIAGS
-	       if (diagnose)
+					if (diagnose) {
-		 dg_whole_comp (e, outer);
+						dg_whole_comp(e, r);
-			/* also represent movement of c !!!!!!!!!!!!!!!!!!!!!!!!! */
-#endif
-	       replace(e, outer, scope);
-	       retcell(e);
-	       return 1;
-	     };
-           };
-	  return 0;
-	};
-      case chvar_tag: {
-#ifdef value_of_null
-	  if (name(son(e))==null_tag) {
-	    setname(son(e), val_tag);
-	    no(son(e))= value_of_null;
-	    clearbigval(son(e));
-	    sh (son (e)) = sh(e);
-#ifdef NEWDIAGS
- 	    if (diagnose)
-	      dg_whole_comp (e, son(e));
-#endif
-	    replace (e, son (e), scope);
-	    retcell (e);
-	    return (1);
-	  };
+					}
-#endif
-	  if (name (son (e)) == val_tag && optop(e)) {
-	    /* evaluate chvar(const) */
-	    int bg;
-	    flt64 x;
-	    shape sha = sh(e);
-	    x = exp_to_f64(son(e));
-/*
-#if has64bits
-  int sg = is_signed(sha);
-  if (extra_checks && sg && !in_proc_def &&
-	shape_size(sha) <= 32 && check_size(x, sg, 32)) {
-    failer("Change_variety out of range");
-    exit(EXIT_FAILURE);
-  };
 #endif
+					replace(e, r, scope);
+					retcell(son(e));
+					retcell(e);
+					return(1);
-*/
+				}
+				if (name(bro(son(e))) == offset_add_tag) {
+					exp p = son(e);
+					exp a = son(bro(p));
+					exp c = bro(a);
+					if (name(c) == val_tag &&
+					    !isbigval(c)) {
+						exp ap = hold_check(me_b3(f_pointer(long_to_al(al2(sh(a)))),
+							 p, a, addptr_tag));
+						exp r = getexp(sh(e), nilexp, 0,
+							       ap, nilexp, 0,
+							       no(c), reff_tag);
-	    dochvar_f (&x, sha);
+						setfather(r, ap);
+#ifdef NEWDIAGS
+						dgf(r) = dgf(e);
+#endif
+						replace(e, hold_check(r),
+							scope);
+						retcell(e);
+						return 1;
+					}
+					if (al1(sh(p)) == al2(sh(c))) {
+						exp inner, outer;
-	    no(son(e)) = f64_to_flpt(x, is_signed(sha), &bg,
+						inner = hold_check(me_b3(sh(e),
-					 shape_size(sha));
+							p, a, addptr_tag));
+#ifdef NEWDIAGS
-	    if (bg)
+						if (diagnose) {
+							dg_whole_comp(bro(p),
+								      inner);
+						}
+#endif
+						outer = hold_check(me_b3(sh(e),
+							inner, c, addptr_tag));
+#ifdef NEWDIAGS
-	      setbigval(son(e));
+						if (diagnose) {
+							dg_whole_comp(e, outer);
-	    else
+						}
+						/* also represent movement of
+						 * c! */
+#endif
+						replace(e, outer, scope);
+						retcell(e);
+						return 1;
+					}
+				}
+				return 0;
+		case chvar_tag:
+#ifdef value_of_null
+			if (name(son(e)) ==null_tag) {
+				setname(son(e), val_tag);
+				no(son(e)) = value_of_null;
-	      clearbigval(son(e));
+				clearbigval(son(e));
-	    sh (son (e)) = sha;
+				sh(son(e)) = sh(e);
 #ifdef NEWDIAGS
- 	    if (diagnose)
+				if (diagnose) {
-	      dg_whole_comp (e, son(e));
+					dg_whole_comp(e, son(e));
+				}
 #endif
-	    replace (e, son (e), scope);
+				replace(e, son(e), scope);
-	    retcell (e);
+				retcell(e);
-	    return (1);
+				return(1);
-	  };
+			}
+#endif
-	  if (eq_shape (sh (e),  sh (son (e)))) {
+			if (name(son(e)) == val_tag && optop(e)) {
-	    /* replace identity chvar by argument */
+				/* evaluate chvar(const) */
+				int bg;
+				flt64 x;
+				shape sha = sh(e);
+				x = exp_to_f64(son(e));
+				/*
+#if has64bits
+				int sg = is_signed(sha);
+				if (extra_checks && sg && !in_proc_def &&
+				    shape_size(sha) <= 32 &&
+				    check_size(x, sg, 32)) {
+					failer("Change_variety out of range");
+					exit(EXIT_FAILURE);
+				}
+#endif
+				 */
+				dochvar_f(&x, sha);
+				no(son(e)) = f64_to_flpt(x, is_signed(sha), &bg,
+							 shape_size(sha));
+				if (bg) {
+					setbigval(son(e));
+				} else {
+					clearbigval(son(e));
+				}
+				sh(son(e)) = sha;
 #ifdef NEWDIAGS
- 	    if (diagnose)
+				if (diagnose)
-	      dg_whole_comp (e, son(e));
+					dg_whole_comp(e, son(e));
 #endif
-	    replace (e, son (e), scope);
+				replace(e, son(e), scope);
+				retcell(e);
+				return(1);
+			}
+			if (eq_shape(sh(e), sh(son(e)))) {
+				/* replace identity chvar by argument */
+#ifdef NEWDIAGS
+				if (diagnose) {
+					dg_whole_comp(e, son(e));
+				}
+#endif
+				replace(e, son(e), scope);
-	    retcell (e);
+				retcell(e);
-	    return (1);
+				return(1);
-	  };
+			}
-	  if (name(son(e)) == chvar_tag &&
+			if (name(son(e)) == chvar_tag &&
+					shape_size(sh(e)) ==
-		 shape_size(sh(e)) == shape_size(sh(son(son(e)))) &&
+					shape_size(sh(son(son(e)))) &&
-		 name(sh(son(e))) == bitfhd) {
+					name(sh(son(e))) == bitfhd) {
-	    exp res = hold_check(me_u3(sh(e), son(son(e)), chvar_tag));
+				exp res = hold_check(me_u3(sh(e),
+							son(son(e)),
+							chvar_tag));
-	    replace(e, res, scope);
+				replace(e, res, scope);
-	    retcell(e);
+				retcell(e);
-	    return 1;
+				return 1;
-	  };
+			}
-	  if (name(son(e)) == chvar_tag && !is_signed(sh(e)) &&
+			if (name(son(e)) == chvar_tag &&
+					!is_signed(sh(e)) &&
+					shape_size(sh(e)) ==
-		shape_size(sh(e)) == shape_size(sh(son(e)))) {
+					shape_size(sh(son(e)))) {
-	    replace(e, hold_check(me_u3(sh(e), son(son(e)), chvar_tag)),
+				replace(e, hold_check(me_u3(sh(e),
-			scope);
+								son(son(e)), chvar_tag)), scope);
-	    retcell(e);
+				retcell(e);
-	    return 1;
+				return 1;
-	  };
+			}
-	  if (name(son(e)) == chvar_tag && !is_signed(sh(e)) &&
+			if (name(son(e)) == chvar_tag &&
+					!is_signed(sh(e)) &&
+					shape_size(sh(e)) <
-		shape_size(sh(e)) < shape_size(sh(son(e))) &&
+					shape_size(sh(son(e))) &&
+					shape_size(sh(e)) ==
-		shape_size(sh(e)) == shape_size(sh(son(son(e))))) {
+					shape_size(sh(son(son(e))))) {
-	    replace(e, hold_check(me_u3(sh(e), son(son(e)), chvar_tag)),
+				replace(e, hold_check(me_u3(sh(e),
+								son(son(e)), chvar_tag)),
-			scope);
+						scope);
-	    retcell(e);
+				retcell(e);
-	    return 1;
+				return 1;
-	  };
+			}
 #if little_end & has_byte_regs
-	  /* only for little enders which have byte registers */
+			/* only for little enders which have byte
+			 * registers */
+			if ((shape_size(sh(e)) <=
-	  if ((shape_size(sh(e)) <= shape_size(sh(son(e)))) && optop(e) &&
+						shape_size(sh(son(e)))) && optop(e) &&
-	      (name (son (e)) == name_tag ||
+					(name(son(e)) == name_tag ||
-		name (son (e)) == cont_tag ||
+					 name(son(e)) == cont_tag ||
-		name (son (e)) == cond_tag
+					 name(son(e)) == cond_tag)) {
-	      )) {
+				/* if the chvar operation never needs
-	    /* if the chvar operation never needs any action for a little
+				 * any action for a little end machine,
-	       end machine, eliminate it */
+				 * eliminate it */
 #if is80x86
-	    if (shape_size(sh(e)) == 8) {
+				if (shape_size(sh(e)) == 8) {
-	      if (name (son (e)) == name_tag)
+					if (name(son(e)) == name_tag) {
-		setvis(son(son(e)));
+						setvis(son(son(e)));
+					}
-	      if (name (son (e)) == cont_tag &&
+					if (name(son(e)) == cont_tag &&
-			name(son(son(e))) == name_tag )
+							name(son(son(e))) ==
+							name_tag) {
-		setvis(son(son(son(e))));
+						setvis(son(son(son(e))));
-	    };
+					}
+				}
 #endif
-	    sh (son (e)) = sh (e);
+				sh(son(e)) = sh(e);
-	    replace (e, son (e), scope);
+				replace(e, son(e), scope);
-		/* should this retcell(e) ? */
+				/* should this retcell(e) ? */
-	    return (1);
+				return(1);
-	  };
+			}
-	  /* only for little enders which have byte registers */
+			/* only for little enders which have byte
+			 * registers */
-	  if (name (son (e)) == chvar_tag &&
+			if (name(son(e)) == chvar_tag &&
+					shape_size(sh(e)) <=
-	      shape_size(sh(e)) <= shape_size(sh (son (e)))) {
+					shape_size(sh(son(e)))) {
-	    /* if the chvar operation never needs any action for a little
+				/* if the chvar operation never needs
+				 * any action for a little end machine,
-	       end machine, eliminate it */
+				 * eliminate it */
-	    exp w;
+				exp w;
-	    sh (son (e)) = sh (e);
+				sh(son(e)) = sh(e);
-	    w = hold (son (e));
+				w = hold(son(e));
-	    IGNORE check (son (w), son (w));
+				IGNORE check(son(w), son(w));
-	    replace (e, son (w), scope);
+				replace(e, son(w), scope);
-	    retcell (e);
+				retcell(e);
-	    retcell (w);
+				retcell(w);
-	    return (1);
+				return(1);
-	  };
+			}
 #endif
 #if little_end & has_byte_ops
-	  /* only for little enders with byte and short operations */
+			/* only for little enders with byte and short
+			 * operations */
+			if (shape_size(sh(e)) <=
-	  if (shape_size(sh(e)) <= shape_size(sh (son (e))) && optop(e) &&
+					shape_size(sh(son(e))) && optop(e) &&
-		name(sh(e)) != bitfhd &&
+					name(sh(e)) != bitfhd &&
-	       (name (son (e)) == plus_tag ||
+					(name(son(e)) == plus_tag ||
-		name (son (e)) == minus_tag ||
+					 name(son(e)) == minus_tag ||
-		name (son (e)) == and_tag ||
+					 name(son(e)) == and_tag ||
-		name (son (e)) == or_tag ||
+					 name(son(e)) == or_tag ||
-		name (son (e)) == neg_tag
+					 name(son(e)) == neg_tag)) {
-	      )
-	    ) {
+				/* replace chvar(op(a ...)) by
-	    /* replace chvar(op(a ...)) by op(chvar(a)...) if the
+				 * op(chvar(a)...) if the changevar
-	       changevar requires no action on a little end machine */
+				 * requires no action on a little end
+				 * machine */
 #if only_lengthen_ops
-	      exp p = son (e);
+				exp p = son(e);
-	      exp r;
+				exp r;
-	      exp a = son (p);
+				exp a = son(p);
-	      exp n = bro (a);
+				exp n = bro(a);
-	      int l = (int)last (a);
+				int l = (int)last(a);
-/*
-	      if (shape_size(sh(e)) >= 16)
+				/* if (shape_size(sh(e)) >= 16) */
-*/
-	  /* this is to avoid allocating bytes to edi/esi in 80386 !!! bad
+				/* this is to avoid allocating bytes to
-	  */
-#endif
-	    {
-	      exp sha = sh (e);
-	      exp t = varchange (sha, a);
+				 * edi/esi in 80386 !!! bad
-	      exp q = t;
-	      while (!l) {
-	        l = (int)last (n);
-	        a = n;
-	        n = bro (n);
-	        setbro (q, varchange (sha, a));
-	        clearlast (q);
-	        q = bro (q);
-	      };
-	      r = getexp (sha, nilexp, 0, t, pt (p), 0, no (p),
-		  name (p));
-              seterrhandle(r, errhandle(e));
-	      replace (e, hc (r, q), scope);
-	      retcell (e);
-	      return (1);
-	    };
+				 */
-	  };
 #endif
-	  if (name (son (e)) == ident_tag && isvar (son (e))) {
-	    /* distribute chvar into variable declaration of simple form
-	    */
-	    exp vardec = son (e);
-	    exp def = son (vardec);
-	    exp body = bro (def);
-	    exp res;
-	    bool go = 1;
-	    exp t, u, v;
-	    if (name (body) != seq_tag)
-	      return (0);
-	    res = bro (son (body));
-	    if (name (res) != cont_tag || name (son (res)) != name_tag ||
-		son (son (res)) != vardec)
-	      return (0);
-	    t = pt (vardec);
-	    while (t != nilexp && go) {
-	      if (t == son (res) || (!last (t) &&
-		    name (bro (bro (t))) == ass_tag))
-		t = pt (t);
-	      else
-		go = 0;
-	    };
-	    if (!go)
-	      return (0);
-	    if (name(def) == clear_tag) {
-	      u = copy(def);
-	      sh(u) = sh(e);
-	    }
-	    else
-	      u = varchange (sh (e), copy (def));
-	    replace (def, u, u);
-	    kill_exp (def, def);
-	    sh (res) = sh (e);
-	    sh (body) = sh(e);
-	    t = pt (vardec);
-	    while (t != nilexp) {
-	      if (t != son (res)) {
-		v = bro (t);
-		u = varchange (sh (e), copy (v));
-		replace (v, u, u);
-		kill_exp (v, def);
-	      };
-	      t = pt (t);
-	    };
-	    sh (vardec) = sh (e);
-	    replace (e, vardec, scope);
-	    retcell (e);
-	    return (1);
-	  };
+				{
-	  return 0;
-	};
-      case bitf_to_int_tag:
-        {
-	  if (newcode) {
-	    exp temp = son(e);
+					exp sha = sh(e);
-	    int szbf = shape_size(sh(temp));
-	    shape sha;
-	    int sg = is_signed(sh(temp));
+					exp t = varchange(sha, a);
-	    int s;
+					exp q = t;
-	    if (szbf <= 8)
+					while (!l) {
-	      sha = (sg) ? scharsh : ucharsh;
-	    else
-	    if (szbf <= 16)
-	      sha = (sg) ? swordsh : uwordsh;
-	    else
-	    if (szbf <= 32)
+						l = (int)last(n);
-	      sha = (sg) ? slongsh : ulongsh;
-	    else
+						a = n;
-	      sha = (sg) ? s64sh : u64sh;
-	    if (name(sh(temp)) == bitfhd && name(temp) == chvar_tag) {
-	      exp st = son(temp);
-	      int n = name(st);
+						n = bro(n);
-	      if ((n == cont_tag && szbf == shape_size(sh(st))) ||
-		  ( n==and_tag && name(bro(son(st)))== val_tag &&
-			no(bro(son(st))) == (1<<szbf)-1 ) ||
-		  ( n==shr_tag && name(bro(son(st)))== val_tag &&
-			no(bro(son(st))) == shape_size(sh(st))-szbf)  ) {
-		/* arises from bfcont_tag */
+						setbro(q, varchange(sha,
-	        replace(e, hold_check(me_u3(sh(e), st, chvar_tag)),
-		      scope);
+									a));
-	        retcell(e);
-	        retcell(temp);
+						clearlast(q);
-	        return 1;
+						q = bro(q);
-	      }
-	    };
+					}
-	    sh(temp) = sha;
-	    if (sg) {
-#if isAlpha
-	      s = shape_size(s64sh) - szbf;
+					r = getexp(sha, nilexp, 0, t,
-	      if (s != 0) {
+							pt(p), 0, no(p),
-		temp = hold_check(me_u3(s64sh, temp, chvar_tag));
-	        temp =
+							name(p));
-		    hold_check(me_b3(s64sh, temp,
-				 me_shint(s64sh, s), shl_tag));
+					seterrhandle(r, errhandle(e));
-	        temp =
-		    hold_check(me_b3(s64sh, temp,
-				 me_shint(s64sh, s), shr_tag));
+					replace(e, hc(r, q), scope);
-	      };
-#else
-	      s = shape_size(sha) - szbf;
-	      if (s != 0) {
-	        temp =
+					retcell(e);
-		  hold_check(me_b3(sha, temp, me_shint(sha, s),
-				 shl_tag));
+					return(1);
-	        temp =
-		    hold_check(me_b3(sha, temp, me_shint(sha, s),
-				 shr_tag));
+				}
-	      };
+			}
 #endif
+			if (name(son(e)) == ident_tag &&
+					isvar(son(e))) {
+				/* distribute chvar into variable declaration of simple form
+				*/
+				exp vardec = son(e);
+				exp def = son(vardec);
+				exp body = bro(def);
+				exp res;
+				bool go = 1;
+				exp t, u, v;
+				if (name(body) != seq_tag)
+					return(0);
+				res = bro(son(body));
+				if (name(res) != cont_tag ||
+						name(son(res)) != name_tag ||
+						son(son(res)) != vardec)
+					return(0);
+				t = pt(vardec);
+				while (t != nilexp && go) {
+					if (t == son(res) ||
+							(!last(t) &&
+							 name(bro(bro(t))) ==
+							 ass_tag)) {
+						t = pt(t);
+					} else {
+						go = 0;
-	    }
+					}
+				}
+				if (!go) {
+					return(0);
+				}
+				if (name(def) == clear_tag) {
+					u = copy(def);
+					sh(u) = sh(e);
-	    else {
+				} else {
-	        int mask = (szbf == 32) ? -1 : (1 << szbf) - 1;
+					u = varchange(sh(e), copy(def));
+				}
+				replace(def, u, u);
+				kill_exp(def, def);
+				sh(res) = sh(e);
+				sh(body) = sh(e);
+				t = pt(vardec);
+				while (t != nilexp) {
-	        temp = hold_check(me_b3(sha, temp,
+					if (t != son(res)) {
+						v = bro(t);
-				 me_shint(sha, mask), and_tag));
+						u = varchange(sh(e), copy(v));
+						replace(v, u, u);
+						kill_exp(v, def);
-	    };
+					}
+					t = pt(t);
+				}
+				sh(vardec) = sh(e);
-	    replace(e, hold_check(me_u3(sh(e), temp, chvar_tag)), scope);
+				replace(e, vardec, scope);
-	    retcell(e);
+				retcell(e);
-	    return 1;
+				return(1);
-	  };
+			}
-          return 0;
+			return 0;
-        };
-      case int_to_bitf_tag:
+		case bitf_to_int_tag:
-        {
-	  if (newcode) {
+			if (newcode) {
-	    exp temp = son(e);
+				exp temp = son(e);
+				int szbf = shape_size(sh(temp));
+				shape sha;
+				int sg = is_signed(sh(temp));
+				int s;
+				if (szbf <= 8) {
+					sha = (sg)? scharsh : ucharsh;
+				} else if (szbf <= 16) {
+					sha = (sg)? swordsh : uwordsh;
+				} else if (szbf <= 32) {
+					sha = (sg)? slongsh : ulongsh;
+				} else {
+					sha = (sg)? s64sh : u64sh;
+				}
+				if (name(sh(temp)) == bitfhd &&
+				    name(temp) == chvar_tag) {
-	    shape sha = sh(temp);
+					exp st = son(temp);
+					int n = name(st);
+					if ((n == cont_tag &&
-	    int szbf = shape_size(sh(e));
+					     szbf == shape_size(sh(st))) ||
+					    (n == and_tag &&
+					     name(bro(son(st))) == val_tag &&
+					     no(bro(son(st))) == (1 << szbf) -1)
+					    || (n == shr_tag &&
+						name(bro(son(st))) == val_tag &&
+						no(bro(son(st))) ==
+						shape_size(sh(st)) -szbf)) {
+						/* arises from bfcont_tag */
+						replace(e,
-	    int sg = is_signed(sh(e));
+							hold_check(me_u3(sh(e),
+							st, chvar_tag)), scope);
+						retcell(e);
+						retcell(temp);
+						return 1;
+					}
+				}
-	    if (shape_size(sh(son(e))) < szbf) {
-	      if (szbf <= 32)
+				sh(temp) = sha;
-	        sha = (sg) ? slongsh : ulongsh;
-	      else
-	        sha = (sg) ? s64sh : u64sh;
 #if is80x86
-	  return (comm_ass (e, mult_tag, mult_fn,
+			return(comm_ass(e, mult_tag, mult_fn, 1, 1, 0, scope,
-, 1, 0, scope, 0, 0));
+, 0));
 #else
-	  return (comm_ass (e, mult_tag, mult_fn,
+			return(comm_ass(e, mult_tag, mult_fn, 1, 1, 0, scope,
-, 1, 0, scope, 1, 0));
+, 0));
 #endif
-	};
-      case subptr_tag: {
+		case subptr_tag: {
-	  /* replace subptr(a, b) by addptr(a, (-b)) */
+			/* replace subptr(a, b) by addptr(a, (-b)) */
-	  exp z = getexp (sh (e), nilexp, 0, bro (son (e)), nilexp,
+			exp z = getexp(sh(e), nilexp, 0, bro(son(e)), nilexp,
 , 0, neg_tag);
-	  exp a2 = hc (z, bro (son (e)));
+			exp a2 = hc(z, bro(son(e)));
-	  exp r = getexp (sh (e), nilexp, 0, son (e), nilexp, 0,
+			exp r = getexp(sh(e), nilexp, 0, son(e), nilexp, 0,
 , addptr_tag);
-	  bro (son (e)) = a2;
+			bro(son(e)) = a2;
 #ifdef NEWDIAGS
-	  if (diagnose)
+			if (diagnose) {
-	    dgf(r) = dgf(e);
+				dgf(r) = dgf(e);
+			}
+#endif
+			replace(e, hc(r, a2), scope);
+			retcell(e);
+			return(1);
+		}
+		case neg_tag: {
+			if (!optop(e)) {
+				return 0;
+			}
+			if (name(son(e)) == val_tag) {
+				/* eval for const */
+				neg_fn(son(e));
+				sh(son(e)) = sh(e);
+#ifdef NEWDIAGS
+				if (diagnose) {
+					dg_whole_comp(e, son(e));
+				}
+#endif
+				replace(e, son(e), scope);
+				retcell(e);
+				return(1);
+			}
+			if (name(son(e)) == neg_tag && optop(e) &&
+			    optop(son(e))) {
+				/* replace --a by a if errtreat is impossible
+				 * or ignore */
+				sh(son(son(e))) = sh(e);
+#ifdef NEWDIAGS
+				if (diagnose) {
+					dg_whole_comp(son(e), son(son(e)));
+					dg_whole_comp(e, son(son(e)));
+				}
+#endif
+				replace(e, son(son(e)), scope);
+				retcell(son(e));
+				retcell(e);
+				return(1);
+			}
+			if (name(son(e)) == plus_tag && optop(e) &&
+			    optop(son(e))) {
+				/* replace negate(plus(a, b ..)) by
+				 * plus(negate(a), negate(b) ..)) */
+				exp r = getexp(sh(e), nilexp, 0, nilexp, nilexp,
+, 0, plus_tag);
+				exp t = son(son(e));
+				exp p = r;
+				int lst;
+				do {
+					exp q = hold(getexp(sh(e), nilexp, 0,
+							    t, nilexp, 0, 0,
+							    neg_tag));
+					exp next = bro(t);
+					lst = (int)last(t);
+					bro(t) = son(q);
+					setlast(t);
+					IGNORE check(son(q), scope);
+					bro(p) = son(q);
+					retcell(q);
+					p = bro(p);
+					clearlast(p);
+					t = next;
+				} while (!lst);
+				son(r) = bro(r);
+#ifdef NEWDIAGS
+				if (diagnose) {
+					dg_whole_comp(e, r);
+				}
 #endif
-	  replace (e, hc (r, a2), scope);
+				replace(e, hc(r, p), scope);
-	  retcell (e);
+				retcell(e);
-	  return (1);
+				return(1);
+			}
+			return 0;
-	};
+		}
+		case shl_tag:
-      case neg_tag: {
+		case shr_tag:
+			if (name(bro(son(e))) == val_tag &&
-          if (!optop(e))
+			    no(bro(son(e))) == 0) {
+				/* remove zero place shift */
+				sh(son(e)) = sh(e);
+				replace(e, son(e), scope);
+				retcell(e);
-            return 0;
+				return(1);
+			}
-	  if (name (son (e)) == val_tag) {/* eval for const */
+			if (name(son(e)) == val_tag &&
-	    neg_fn (son (e));
+			    name(bro(son(e))) == val_tag) {
+				/* evaluate if both args constant */
+				doshl(e);
-	    sh(son(e)) = sh(e);
+				sh(son(e)) = sh(e);
+				replace(e, son(e), scope);
+				retcell(e);
+				return(1);
+			}
-#ifdef NEWDIAGS
+#if ismips
+			if (name(bro(son(e))) == val_tag &&
+			    no(bro(son(e))) == shape_size(sh(e))) {
-	    if (diagnose)
+				exp s1 = copy(e);
+				no(bro(son(s1)))--;
+				if (name(e) ==shl_tag) {
+					s1 = f_shift_left(f_continue, s1,
+					     me_shint(sh(bro(son(e))), 1));
+				} else {
+					s1 = f_shift_right(s1,
+					     me_shint(sh(bro(son(e))), 1));
+				}
+				replace(e, s1, scope);
+				kill_exp(e, scope);
+				return 1;
+			}
+#endif
+#if has_neg_shift
+			/* only use if the shift left and shift right
+			 * operations are performed by the same instruction,
+			 * distinguished by the sign of the number of places */
+			if (name(e) == shr_tag) {
-	      dg_whole_comp (e, son(e));
+				exp places = bro(son(e));
+				exp r;
+				exp neg = getexp(sh(places), nilexp, 0, places,
+						 nilexp, 0, 0, neg_tag);
+				neg = hc(neg, places);
+				r = getexp(sh(e), nilexp, 0, son(e), nilexp, 0,
+, shl_tag);
+				bro(son(e)) = neg;
+				r = hc(r, neg);
+				replace(e, r, scope);
+				retcell(e);
+				return(1);
+			}
 #endif
 #if has_byte_ops
-	if (name(bro(son(e))) == val_tag &&
+			if (name(bro(son(e))) == val_tag &&
-	    no(bro(son(e))) == 0xff &&
+			    no(bro(son(e))) == 0xff &&
-	    name(son(e)) == shr_tag &&
+			    name(son(e)) == shr_tag &&
-	    name(son(son(e))) == cont_tag
+			    name(son(son(e))) == cont_tag) {
-	    ) {
-	  exp a1 = bro(son(son(e)));
+				exp a1 = bro(son(son(e)));
-	  if (name(a1) == val_tag && !isbigval(a1) &&
+				if (name(a1) == val_tag && !isbigval(a1) &&
-	      (no(a1) & 0x7) == 0) {
+				    (no(a1) & 0x7) == 0) {
-	    exp t = son(son(son(e)));
+					exp t = son(son(son(e)));
-	    exp r = me_u3(sh(t), t, reff_tag);
+					exp r = me_u3(sh(t), t, reff_tag);
-	    exp c, v;
+					exp c, v;
 #if little_end
-	    no(r) = no(a1);
+					no(r) = no(a1);
 #else
-	    no(r) = shape_size(sh(e)) - no(a1) - 8;
+					no(r) = shape_size(sh(e)) - no(a1) - 8;
-#endif
-	    r = hold_check(r);
-	    c = hold_check(me_u3(ucharsh, r, cont_tag));
-	    v = hold_check(me_u3(sh(e), c, chvar_tag));
-	    replace(e, v, scope);
-	    retcell(e);
-	    return 1;
-	  };
-	};
-#endif
-	if (name(son(e)) == and_tag && name(bro(son(e))) == val_tag &&
-		name(bro(son(son(e)))) == val_tag
-		&& !isbigval(bro(son(e))) && !isbigval(bro(son(son(e))))) {
-	  int mask = no(bro(son(e))) & no(bro(son(son(e))));
-	  exp res = hold_check(me_b3(sh(e), son(son(e)),
-				me_shint(sh(e), mask), and_tag));
-	  replace(e, res, scope);
-	  retcell(e);
-	  return 1;
-	};
-	if (name(son(e)) == shr_tag && name(bro(son(e))) == val_tag &&
-		!isbigval(bro(son(e)))) {
-	  exp arg1 = son(e);
-	  exp arg2 = bro(arg1); /* mask */
-	  int m = no(arg2);
-	  int sz = shape_size(sh(arg1));
-	  if (m > 0 && name(bro(son(arg1))) == val_tag &&
-		!isbigval(bro(son(arg1))) &&
-		m <= ((1 << (sz - no(bro(son(arg1))))) - 1)) {
-	    exp arg11 = son(arg1);
-	    exp arg12 = bro(arg11); /* right shift places */
-	    if (name(arg11) == shl_tag &&
-		 name(bro(son(arg11))) == val_tag &&
-		!isbigval(bro(son(arg11)))) {
-	      exp arg111 = son(arg11);
-	      exp arg112 = bro(arg111); /* left shift places */
-	      if (no(arg112) <= no(arg12)) {
-		exp res = hold_check(me_b3(sh(arg1), arg111,
-			      me_shint(sh(arg1), no(arg12) - no(arg112)),
-			    shr_tag));
-		replace(arg1, res, res);
-		return check(e, scope);
-	      };
-	    };
-	  };
-	};
-	/* apply commutative and associative laws */
-	return (comm_ass (e, and_tag, and_fn, all_ones (son(e)),
-, 0, scope, 1, 0));
-      case or_tag:
-	/* apply commutative and associative laws */
-	if (name(son(e)) == and_tag &&
-		name(bro(son(e))) == val_tag &&
-		!isbigval(bro(son(e))) &&
-		name(bro(son(son(e))))) {
-	  exp arg1 = son(e);
-	  int q = no(bro(arg1));
-	  exp arg11 = son(arg1);
-	  int p = no(bro(arg11));
-	  if ((q | p) == (int)0xffffffff) {
-	    exp res = me_b3(sh(e), arg11, bro(arg1), or_tag);
-	    replace(e, hold_check(res), scope);
-	    retcell(e);
-	    return 1;
-	  };
-	};
-	return (comm_ass (e, or_tag, or_fn, 0, shape_size(sh(e)) <= 32,
-		 all_ones (son(e)),
-	         scope, 1, 0));
-      case xor_tag:
-	/* apply commutative and associative laws */
-	return (comm_ass (e, xor_tag, xor_fn, 0, 0,
-, scope, 1, 0));
-      case not_tag: {
-	  if (name (son (e)) == val_tag) {/* eval for const */
-	    not_fn (son (e));
-	    sh(son(e)) = sh(e);
-	    replace (e, son (e), scope);
-	    retcell (e);
-	    return (1);
-	  };
-	  if (name (son (e)) == not_tag) {/* not(not(x)) -> x */
-	    sh(son(son(e))) = sh(e);
-	    replace (e, son (son (e)), scope);
-	    retcell (son (e));
-	    retcell (e);
-	    return (1);
-	  };
-	  return 0;
-	};
-     case cont_tag:
-#ifdef promote_pars
-	{ int x = al1_of(sh(son(e)))->al.sh_hd;
-	  if (x >= scharhd && x <= uwordhd && !little_end) {
-		int disp = shape_size(ulongsh)-((x>=swordhd)?16:8);
-		exp r = getexp(f_pointer(f_alignment(sh(e))), nilexp,
-, son(e), nilexp, 0, disp, reff_tag);
-		bro(son(r)) = r;
-		son(e) = hold_check(r);
-		bro(son(e)) = e; setlast(son(e));
-		return 1;
-	  }
-	}
-#endif
-#ifndef NEWDIAGS
-        if (name(son(e)) == diagnose_tag)
-          {
-            exp diag = son(e);
-            exp p = son(diag);
-            exp r = getexp(sh(e), nilexp, 0, p, nilexp, 0,
-, cont_tag);
-            exp d;
-            r = hc(r, p);
-            d = getexp(sh(e), nilexp, 0, r, pt(diag), props(diag),
-                        no(diag), diagnose_tag);
-            setfather(d, r);
-            replace(e, d, scope);
-            retcell(son(e));
-            retcell(e);
-            return 1;
-          };
-#endif
-        return 0;
-    case field_tag:
-      if (name(son(e)) == compound_tag && nos (son(e))) {
-	exp s = son(son(e));
-	for(;;) {
-		if ( no(s)==no(e)
-			&& eq_shape(sh(e), sh(bro(s)))) {
-		   replace(e, copy(bro(s)), scope);
-		   kill_exp(e, scope);
-		   return 1;
-		}
-		if (last(bro(s))) break;
-		s = bro(bro(s));
-	}
-      }
-      if (name(son(e)) == nof_tag && nos (son(e))
-		&& eq_shape(sh(e), sh(son(son(e)))) ) {
-	exp s = son(son(e));
-	int sz = rounder(shape_size(sh(s)), shape_align(sh(s)));
-	int n = 0;
-	for(; no(e)<=n; n+=sz) {
-		if (no(e)==n) {
-			replace(e, copy(s), scope);
-			kill_exp(e, scope);
-		        return 1;
-		}
-		if (last(s)) break;
-		s = bro(s);
-	}
-      }
-      if (name (son (e)) == name_tag) {
-	/* replace field on name by name with offset in no */
-	no (son (e)) += no (e);
-	sh (son (e)) = sh (e);
-	replace (e, son (e), scope);
-	retcell (e);
-	return (1);
-      };
-      if (name (son (e)) == cont_tag) {
-	/* replace field[n](cont(x)) by cont(reff[n](x)) */
-	exp arg = son (son (e));
-	exp rf1 = getexp (sh (arg), nilexp, 0, arg, nilexp, 0,
-	    no (e), reff_tag);
-	exp rf = hc (rf1, arg);
-	exp c = getexp (sh (e), nilexp, 0, rf, nilexp, 0, 0, cont_tag);
-	replace (e, hc (c, rf), scope);
-	retcell (son (e));
-	retcell (e);
-	return (1);
-      };
-      if (name(son(e)) == ident_tag && isvar(son(e)) &&
-           name(son(son(e))) == clear_tag &&
-	   name(bro(son(son(e)))) == seq_tag) {
-	exp var = son(e);
-	exp sq = bro(son(var));
-	if (name(bro(son(sq))) == cont_tag &&
-	    name(son(bro(son(sq)))) == name_tag &&
-	    son(son(bro(son(sq)))) == var) {
-	  int count = 0;
-	  int good = 0;
-	  exp p = son(son(sq));
-	  exp q;
-	  exp res;
-	  while (p != son(sq)) {
-	    if (name(p) != ass_tag || name(son(p)) != name_tag ||
-	        son(son(p)) != var)
-	      return 0;
-	    ++count;
-	    if (no(son(p)) == no(e))
-	      good = 1;
-	    p = bro(p);
-	  }
-	  if ((count+1) != no(var) || !good)
-	    return 0;
-	  p = son(son(sq));
-	  while (p != son(sq)) {
-	    q = bro(p);
-	    if (no(son(p)) == no(e)) {
-	      exp tp = f_make_top();
-	      res = bro(son(p));
-	      replace(p, tp, tp);
-	    }
-	    else {
-	      exp w = bro(son(p));
-	      replace(p, w, w);
-	    }
-	    p = q;
-	  }
-	  SET(res);
-	  replace(bro(son(sq)), res, res);
-	  replace(e, hold_check(sq), scope);
-	  return 1;
-	}
-	return 0;
-      }
-      return (0);
-    case reff_tag:
-      if (name (son (e)) == name_tag &&
-	  isvar (son (son (e))) && al1(sh(e)) > 1) {
-	/* replace reff on name of var by name with offset in no */
-	no (son (e)) += no (e);
-	sh (son (e)) = sh (e);
-#ifdef NEWDIAGS
-	if (diagnose)
-	  dg_whole_comp (e, son(e));
-#endif
-	replace (e, son (e), scope);
-	retcell (e);
-	return (1);
-      };
-      if (name (son (e)) == val_tag) {
-	no (son (e)) += (no (e) / 8);
-	sh (son (e)) = sh (e);
-#ifdef NEWDIAGS
-	if (diagnose)
-	  dg_whole_comp (e, son(e));
-#endif
-	replace (e, son (e), scope);
-	retcell (e);
-	return (1);
-      };
-#if !temp_mips
-      /* confirm mips doesnt need this */
-      if (name (son (e)) == reff_tag) {
-	/* combine reff selections */
-	sh (son (e)) = sh (e);
-	no (son (e)) += no (e);
-#ifdef NEWDIAGS
-	if (diagnose)
-	  dg_whole_comp (e, son(e));
-#endif
-	replace (e, son (e), scope);
-	retcell (e);
-	return (1);
-      };
-#endif
-#if remove_zero_offsets
-      if (no(e) == 0 && al1(sh(e)) > 1)
-       {
-          sh(son(e)) = sh(e);
-#ifdef NEWDIAGS
-	  if (diagnose)
-	    dg_whole_comp (e, son(e));
-#endif
-          replace(e, son(e), scope);
-          retcell(e);
-          return 1;
-       };
 #endif
-        return (0);
-      case bfcont_tag:
-      case bfcontvol_tag:
-	{
-	  exp p = son(e);
+					r = hold_check(r);
-	  int bsz = shape_size(sh(e));
+					c = hold_check(me_u3(ucharsh, r,
-	  int rsz = al1(sh(p));
+							     cont_tag));
-	  int rsh;
-	  int sg = is_signed(sh(e));
+					v = hold_check(me_u3(sh(e), c,
-	  int off = no(e);
+							     chvar_tag));
-	  exp ref;
-	  exp cont;
-	  exp eshift;
-	  shape ptr_sha;
-	  shape msh;
-	  int temp = off + bsz - 1;
+					replace(e, v, scope);
-	  if (rsz>BF_STORE_UNIT) rsz = BF_STORE_UNIT;
-	  if (((off/8) == (temp/8)) &&
-		(bsz == 8 &&
-		    ((little_end && (off%8 == 0)) ||
-		      (!little_end && ((8 - (off % 8) - bsz) == 0))))) {
-	    rsz = 8;
+					retcell(e);
-	  }
-	  else
-	  if (((off/16) == (temp/16)) &&
-	        (bsz == 16 &&
-		   ((little_end && (off%16 == 0)) ||
-		     (!little_end && ((16 - (off % 16) - bsz) == 0))))) {
-	    rsz = 16;
+					return 1;
-	  }
+				}
-#if isAlpha
-	  else
-	  if (((off/32) == (temp/32)) &&
-	      (!sg || (al1(sh(p)) < 64) ||
-	        (bsz == 32 &&
-		   ((little_end && (off%32 == 0)) ||
-		     (!little_end && ((32 - (off % 32) - bsz) == 0)))))) {
-	    rsz = 32;
-	  }
+			}
 #endif
+			if (name(son(e)) == and_tag &&
+			    name(bro(son(e))) == val_tag &&
+			    name(bro(son(son(e)))) == val_tag &&
-	  else {
+			    !isbigval(bro(son(e))) &&
-		/* all of bitfield must be within same integer variety */
+			    !isbigval(bro(son(son(e))))) {
+				int mask = no(bro(son(e))) &
+				    no(bro(son(son(e))));
-		while ((off/rsz) != (temp/rsz)) { rsz = rsz<<1; }
+				exp res = hold_check(me_b3(sh(e), son(son(e)),
+					  me_shint(sh(e), mask), and_tag));
+				replace(e, res, scope);
+				retcell(e);
+				return 1;
-	  }
+			}
+			if (name(son(e)) == shr_tag &&
+			    name(bro(son(e))) == val_tag &&
+			    !isbigval(bro(son(e)))) {
+				exp arg1 = son(e);
+				exp arg2 = bro(arg1); /* mask */
+				int m = no(arg2);
+				int sz = shape_size(sh(arg1));
+				if (m > 0 && name(bro(son(arg1))) == val_tag &&
+				    !isbigval(bro(son(arg1))) &&
+				    m <=
+				    ((1 << (sz - no(bro(son(arg1))))) - 1)) {
+					exp arg11 = son(arg1);
+					/* right shift places */
+					exp arg12 = bro(arg11);
+					if (name(arg11) == shl_tag &&
+					    name(bro(son(arg11))) == val_tag &&
+					    !isbigval(bro(son(arg11)))) {
+						exp arg111 = son(arg11);
+						/* left shift places */
+						exp arg112 = bro(arg111);
+						if (no(arg112) <= no(arg12)) {
+						  exp res =
+						      hold_check(me_b3(sh(arg1),
+						      arg111, me_shint(sh(arg1),
+						      no(arg12) - no(arg112)),
+						      shr_tag));
+							replace(arg1, res, res);
+							return check(e, scope);
+						}
+					}
+				}
+			}
+			/* apply commutative and associative laws */
+			return(comm_ass(e, and_tag, and_fn, all_ones(son(e)), 1,
+, scope, 1, 0));
+		case or_tag:
+			/* apply commutative and associative laws */
+			if (name(son(e)) == and_tag &&
+			    name(bro(son(e))) == val_tag &&
+			    !isbigval(bro(son(e))) &&
+			    name(bro(son(son(e))))) {
+				exp arg1 = son(e);
+				int q = no(bro(arg1));
+				exp arg11 = son(arg1);
+				int p = no(bro(arg11));
+				if ((q | p) == (int)0xffffffff) {
+					exp res = me_b3(sh(e), arg11, bro(arg1),
+							or_tag);
+					replace(e, hold_check(res), scope);
+					retcell(e);
+					return 1;
+				}
+			}
+			return(comm_ass(e, or_tag, or_fn, 0,
+					shape_size(sh(e)) <= 32,
+					all_ones(son(e)), scope, 1, 0));
+		case xor_tag:
+			/* apply commutative and associative laws */
+			return(comm_ass(e, xor_tag, xor_fn, 0, 0, 0, scope, 1,
+));
+		case not_tag:
+			if (name(son(e)) == val_tag) {
+				/* eval for const */
+				not_fn(son(e));
+				sh(son(e)) = sh(e);
+				replace(e, son(e), scope);
+				retcell(e);
+				return(1);
+			}
+			if (name(son(e)) == not_tag) {
+				/* not(not(x))->x */
+				sh(son(son(e))) = sh(e);
+				replace(e, son(son(e)), scope);
+				retcell(son(e));
+				retcell(e);
+				return(1);
+			}
+			return 0;
+		case cont_tag:
+#ifdef promote_pars
+		{
+			int x = al1_of(sh(son(e)))->al.sh_hd;
+			if (x >= scharhd && x <= uwordhd && !little_end) {
-	  msh = containedshape(rsz, sg);
+				int disp = shape_size(ulongsh) -
+				    ((x >= swordhd) ? 16 : 8);
-	  ptr_sha = f_pointer(long_to_al(rsz));
+				exp r = getexp(f_pointer(f_alignment(sh(e))),
-	  if ((off / rsz) != 0) {
+					       nilexp, 1, son(e), nilexp, 0,
-	    ref = me_u3(ptr_sha, p, reff_tag);
+					       disp, reff_tag);
-	    no(ref) = (off / rsz) * rsz;
+				bro(son(r)) = r;
-	    ref = hold_check(ref);
+				son(e) = hold_check(r);
+				bro(son(e)) = e;
+				setlast(son(e));
+				return 1;
-	  }
+			}
+		}
+#endif
+#ifndef NEWDIAGS
+			if (name(son(e)) == diagnose_tag) {
+				exp diag = son(e);
+				exp p = son(diag);
+				exp r = getexp(sh(e), nilexp, 0, p, nilexp, 0,
+, cont_tag);
-	  else
+				exp d;
-	    ref = p;
+				r = hc(r, p);
+				d = getexp(sh(e), nilexp, 0, r, pt(diag),
+					   props(diag), no(diag), diagnose_tag);
+				setfather(d, r);
+				replace(e, d, scope);
+				retcell(son(e));
-#if little_end
+				retcell(e);
+				return 1;
+			}
+#endif
+			return 0;
+		case field_tag:
+			if (name(son(e)) == compound_tag && nos(son(e))) {
+				exp s = son(son(e));
+				for (;;) {
+					if (no(s) ==no(e) &&
+					    eq_shape(sh(e), sh(bro(s)))) {
+						replace(e, copy(bro(s)), scope);
+						kill_exp(e, scope);
+						return 1;
+					}
+					if (last(bro(s))) {
+						break;
+					}
-	  rsh = off % rsz;
+					s = bro(bro(s));
-#else
+				}
+			}
+			if (name(son(e)) == nof_tag && nos(son(e))
+			    && eq_shape(sh(e), sh(son(son(e))))) {
+				exp s = son(son(e));
+				int sz = rounder(shape_size(sh(s)),
+						 shape_align(sh(s)));
+				int n = 0;
-	  rsh = rsz - (off % rsz) - bsz;
+				for (; no(e) <= n; n += sz) {
+					if (no(e) ==n) {
+						replace(e, copy(s), scope);
+						kill_exp(e, scope);
+						return 1;
+					}
+					if (last(s)) {
+						break;
-#endif
+					}
+					s = bro(s);
+				}
+			}
+			if (name(son(e)) == name_tag) {
+				/* replace field on name by name with offset in
+				 * no */
+				no(son(e)) += no(e);
-	  cont = me_u3(msh, ref,
+				sh(son(e)) = sh(e);
+				replace(e, son(e), scope);
+				retcell(e);
+				return(1);
+			}
-			(name(e) == bfcont_tag)
+			if (name(son(e)) == cont_tag) {
+				/* replace field[n](cont(x)) by
+				 * cont(reff[n](x)) */
+				exp arg = son(son(e));
+				exp rf1 = getexp(sh(arg), nilexp, 0, arg,
+						 nilexp, 0, no(e), reff_tag);
+				exp rf = hc(rf1, arg);
+				exp c = getexp(sh(e), nilexp, 0, rf, nilexp, 0,
-			  ? (unsigned char)cont_tag
+, cont_tag);
+				replace(e, hc(c, rf), scope);
+				retcell(son(e));
+				retcell(e);
+				return(1);
+			}
+			if (name(son(e)) == ident_tag && isvar(son(e)) &&
-			  : (unsigned char)contvol_tag);
+			    name(son(son(e))) == clear_tag &&
-	  if (rsh==0 && !sg && bsz != rsz) {
+			    name(bro(son(son(e)))) == seq_tag) {
+				exp var = son(e);
-	      eshift = me_b3(msh, cont,
+				exp sq = bro(son(var));
+				if (name(bro(son(sq))) == cont_tag &&
+				    name(son(bro(son(sq)))) == name_tag &&
-				 me_shint(slongsh, (1<<bsz)-1), and_tag);
+				    son(son(bro(son(sq)))) == var) {
+					int count = 0;
+					int good = 0;
+					exp p = son(son(sq));
-          }
+					exp q;
+					exp res;
+					while (p != son(sq)) {
+						if (name(p) != ass_tag ||
+						    name(son(p)) != name_tag ||
+						    son(son(p)) != var) {
+							return 0;
+						}
+						++count;
+						if (no(son(p)) == no(e)) {
+							good = 1;
+						}
+						p = bro(p);
+					}
+					if ((count + 1) != no(var) || !good) {
+						return 0;
+					}
+					p = son(son(sq));
+					while (p != son(sq)) {
+						q = bro(p);
+						if (no(son(p)) == no(e)) {
+							exp tp = f_make_top();
+							res = bro(son(p));
+							replace(p, tp, tp);
-	  else {
+						} else {
+							exp w = bro(son(p));
+							replace(p, w, w);
+						}
+						p = q;
+					}
+					SET(res);
-	    if (rsz - bsz - rsh != 0) {
+					replace(bro(son(sq)), res, res);
-		cont = me_b3(msh, cont, me_shint(slongsh,rsz - bsz - rsh),
+					replace(e, hold_check(sq), scope);
-					shl_tag);
+					return 1;
-	    }
+				}
+				return 0;
+			}
+			return(0);
+		case reff_tag:
-	    if (rsz - bsz != 0)
+			if (name(son(e)) == name_tag &&
-	       eshift = me_b3(msh, cont, me_shint(slongsh, rsz-bsz),
+			    isvar(son(son(e))) && al1(sh(e)) > 1) {
+				/* replace reff on name of var by name with
+				 * offset in no */
+				no(son(e)) += no(e);
-				shr_tag);
+				sh(son(e)) = sh(e);
+#ifdef NEWDIAGS
-	    else
+				if (diagnose) {
-	    eshift = cont;
+					dg_whole_comp(e, son(e));
-	  }
+				}
+#endif
-	  eshift = me_u3(sh(e), eshift, chvar_tag);
+				replace(e, son(e), scope);
+				retcell(e);
+				return(1);
+			}
+			if (name(son(e)) == val_tag) {
+				no(son(e)) += (no(e) / 8);
+				sh(son(e)) = sh(e);
+#ifdef NEWDIAGS
+				if (diagnose) {
+					dg_whole_comp(e, son(e));
+				}
+#endif
-	  replace(e, eshift , scope);
+				replace(e, son(e), scope);
-	  retcell(e);
+				retcell(e);
-	  return 1;
+				return(1);
-	};
+			}
-      case abs_tag:
+#if !temp_mips
+			/* confirm mips doesnt need this */
-	if (name (son (e)) == val_tag) {
+			if (name(son(e)) == reff_tag) {
+				/* combine reff selections */
-	  if (is_signed(sh(e)) &&
+				sh(son(e)) = sh(e);
-	  	((isbigval(son(e)) && flptnos[no(son(e))].sign) ||
+				no(son(e)) += no(e);
+#ifdef NEWDIAGS
+				if (diagnose) {
-		 (!isbigval(son(e)) && no(son(e)) < 0))) {/* eval for const */
+					dg_whole_comp(e, son(e));
+				}
+#endif
-	    if (!optop(e)) return 0;
+				replace(e, son(e), scope);
-	    neg_fn (son (e));
+				retcell(e);
+				return(1);
-	  }
+			}
+#endif
+#if remove_zero_offsets
+			if (no(e) == 0 && al1(sh(e)) > 1) {
-	  sh(son(e)) = sh(e);
+				sh(son(e)) = sh(e);
 #ifdef NEWDIAGS
-	  if (diagnose)
+				if (diagnose) {
-	    dg_whole_comp (e, son(e));
+					dg_whole_comp(e, son(e));
+				}
+#endif
+				replace(e, son(e), scope);
+				retcell(e);
+				return 1;
+			}
 #endif
-	  replace (e, son (e), scope);
-	  retcell (e);
-	  return (1);
-	};
-	return 0;
-      case fmax_tag:
-       case fmin_tag:
-	{
-	  bool fmin = (name(e)==fmin_tag);
-	  exp arg1 = son(e);
-	  exp arg2 = bro(arg1);
-	  exp id1 = me_startid(sh(arg1),arg1,0);/* identify arg1 */
-	  exp id2 = me_startid(sh(arg2),arg2,0);/* identify arg2 */
-	  exp seq;
-	  exp cond;
-	  exp zero;
-	  exp lab;
-	  exp clear;
-	  exp test;
-	  clear = getexp(f_bottom,nilexp,0,nilexp,nilexp,0,0,clear_tag);
-	  lab = me_b3(sh(arg2),clear,me_obtain(id2),labst_tag);
-	  test = me_q2(no_nat_option,
-		       f_impossible,
-		       fmin?f_less_than:f_greater_than,
-		       &lab,
-		       me_obtain(id1),
-		       me_obtain(id2),
-		       test_tag);
-	  zero = me_u3(sh(test),test,0);
-	  seq = me_b3(sh(arg1),zero,me_obtain(id1),seq_tag);
-	  cond = me_b3(sh(arg1),seq,lab,cond_tag);
-	  id2 = me_complete_id(id2,cond);
-	  id1 = me_complete_id(id1,id2);
-	  replace(e,id1,scope);
-	  retcell(e);
-	  return 1;
-	}
-      case name_tag: {
-	  exp s = son(e);
-	  if (!isvar(s) && isglob(s) && son(s) != nilexp
-		&& name(sh(e)) == name(sh(son(s)))
-		&& (name(son(s)) == val_tag || name(son(s))==real_tag)) {
-		exp c = copy(son(s));
-		replace(e,c,scope);
-		kill_exp(e,scope);
-		return 1;
-	   }
-	   else return 0;
-      }
-      case fpower_tag:
-      case imag_tag:
-      case make_complex_tag:
-	return 0;
+			return(0);
-      case rotl_tag:
+		case bfcont_tag:
-      case rotr_tag:
+		case bfcontvol_tag: {
-      case env_offset_tag:
-      case general_env_offset_tag:
-      case proc_tag:
+			exp p = son(e);
-      case general_proc_tag:
+			int bsz = shape_size(sh(e));
-      case top_tag:
-      case val_tag:
+			int rsz = al1(sh(p));
-      case real_tag:
+			int rsh;
-      case current_env_tag:
+			int sg = is_signed(sh(e));
-      case make_lv_tag:
+			int off = no(e);
-      case clear_tag:
+			exp ref;
-      case null_tag:
+			exp cont;
-      case string_tag:
+			exp eshift;
-      case power_tag:
+			shape ptr_sha;
-      case contvol_tag:
-        return 0;
-      default:
+			shape msh;
-        return 0;
+			int temp = off + bsz - 1;
-    };
-  };
+			if (rsz>BF_STORE_UNIT)rsz = BF_STORE_UNIT;
-  switch (name (e)) {		/* side effecting ops */
+			if (((off / 8) == (temp / 8)) &&
-    case compound_tag:
+			    (bsz == 8 &&
+			     ((little_end && (off % 8 == 0)) ||
+			      (!little_end && ((8 - (off % 8) - bsz) == 0))))) {
-      {
+				rsz = 8;
+			} else if (((off / 16) == (temp / 16)) &&
-       exp bse = bro(son(e));
+				    (bsz == 16 &&
-       unsigned char shn = name(sh(bse));
+				     ((little_end && (off % 16 == 0)) ||
+				      (!little_end &&
-       if (last(bse) && name(son(e)) == val_tag &&
+				       ((16 - (off % 16) - bsz) == 0))))) {
+				rsz = 16;
+			}
+#if isAlpha
-             no(son(e)) == 0 &&
+			else if (((off / 32) == (temp / 32)) &&
-              shape_size(sh(e)) == shape_size(sh(bse)) &&
+				 (!sg || (al1(sh(p)) < 64) ||
+				  (bsz == 32 &&
-              shn != prokhd && (shn < shrealhd || shn > doublehd)
+				   ((little_end && (off % 32 == 0)) ||
-#if dont_unpad_apply
+				    (!little_end &&
-                 && name(bse) != apply_tag
+				     ((32 - (off % 32) - bsz) == 0)))))) {
+				rsz = 32;
+			}
 #endif
+			else {
+				/* all of bitfield must be within same integer
+				 * variety */
+				while ((off / rsz) != (temp / rsz)) {
+					rsz = rsz << 1;
+				}
+			}
+			msh = containedshape(rsz, sg);
+			ptr_sha = f_pointer(long_to_al(rsz));
+			if ((off / rsz) != 0) {
+				ref = me_u3(ptr_sha, p, reff_tag);
+				no(ref) = (off / rsz) * rsz;
+				ref = hold_check(ref);
+			} else {
+				ref = p;
+			}
+#if little_end
+			rsh = off % rsz;
+#else
+			rsh = rsz - (off % rsz) - bsz;
+#endif
+			cont = me_u3(msh, ref, (name(e) == bfcont_tag) ?
+				     (unsigned char)cont_tag :
+				     (unsigned char)contvol_tag);
+			if (rsh == 0 && !sg && bsz != rsz) {
+				eshift = me_b3(msh, cont,
+					       me_shint(slongsh, (1 << bsz) -1),
+					       and_tag);
+			} else {
+				if (rsz - bsz - rsh != 0) {
+					cont = me_b3(msh, cont,
+						     me_shint(slongsh, rsz -
+						     bsz - rsh), shl_tag);
+				}
+				if (rsz - bsz != 0) {
+					eshift = me_b3(msh, cont,
+						       me_shint(slongsh, rsz -
+								bsz), shr_tag);
+				} else {
+					eshift = cont;
+				}
+			}
+			eshift = me_u3(sh(e), eshift, chvar_tag);
+			replace(e, eshift , scope);
+			retcell(e);
+			return 1;
+		}
+		case abs_tag:
+			if (name(son(e)) == val_tag) {
+				if (is_signed(sh(e)) &&
+				    ((isbigval(son(e)) &&
+				      flptnos[no(son(e))].sign) ||
+				     (!isbigval(son(e)) &&
+				      no(son(e)) < 0))) {
+					/* eval for const */
+					if (!optop(e)) {
+						return 0;
+					}
+					neg_fn(son(e));
+				}
+				sh(son(e)) = sh(e);
+#ifdef NEWDIAGS
+				if (diagnose) {
+					dg_whole_comp(e, son(e));
+				}
+#endif
+				replace(e, son(e), scope);
+				retcell(e);
+				return(1);
+			}
+			return 0;
+		case fmax_tag:
+		case fmin_tag: {
+			bool fmin = (name(e) ==fmin_tag);
+			exp arg1 = son(e);
+			exp arg2 = bro(arg1);
+			/* identify arg1 */
+			exp id1 = me_startid(sh(arg1), arg1, 0);
+			/* identify arg2 */
+			exp id2 = me_startid(sh(arg2), arg2, 0);
+			exp seq;
+			exp cond;
+			exp zero;
+			exp lab;
+			exp clear;
+			exp test;
+			clear = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,
+, clear_tag);
+			lab = me_b3(sh(arg2), clear, me_obtain(id2), labst_tag);
+			test = me_q2(no_nat_option, f_impossible,
+				     fmin ? f_less_than : f_greater_than,
+				     &lab, me_obtain(id1), me_obtain(id2),
+				     test_tag);
+			zero = me_u3(sh(test), test, 0);
+			seq = me_b3(sh(arg1), zero, me_obtain(id1), seq_tag);
+			cond = me_b3(sh(arg1), seq, lab, cond_tag);
+			id2 = me_complete_id(id2, cond);
+			id1 = me_complete_id(id1, id2);
+			replace(e, id1, scope);
+			retcell(e);
+			return 1;
+		}
+		case name_tag: {
+			exp s = son(e);
+			if (!isvar(s) && isglob(s) && son(s) != nilexp &&
+			    name(sh(e)) == name(sh(son(s))) &&
+			    (name(son(s)) == val_tag ||
+			     name(son(s)) == real_tag)) {
+				exp c = copy(son(s));
+				replace(e, c, scope);
+				kill_exp(e, scope);
+				return 1;
+			} else {
+				return 0;
+			}
+		}
+		case fpower_tag:
+		case imag_tag:
+		case make_complex_tag:
+			return 0;
+		case rotl_tag:
+		case rotr_tag:
+		case env_offset_tag:
+		case general_env_offset_tag:
+		case proc_tag:
+		case general_proc_tag:
+		case top_tag:
+		case val_tag:
+		case real_tag:
+		case current_env_tag:
+		case make_lv_tag:
+		case clear_tag:
+		case null_tag:
+		case string_tag:
+		case power_tag:
+		case contvol_tag:
+			return 0;
+		default:
+			return 0;
+		}
+	}
+	/* side effecting ops */
+	switch (name(e)) {
+	case compound_tag: {
+		exp bse = bro(son(e));
+		unsigned char shn = name(sh(bse));
+		if (last(bse) && name(son(e)) == val_tag &&
+		    no(son(e)) == 0 &&
+		    shape_size(sh(e)) == shape_size(sh(bse)) &&
+		    shn != prokhd && (shn < shrealhd || shn > doublehd)
+#if dont_unpad_apply
+		    && name(bse) != apply_tag
+#endif
-          )
+		   ) {
-        {  /* remove the creation of a compound if it consists of a
+			/* remove the creation of a compound if it consists of
-              single value of the same size and provided that the
+			 * a single value of the same size and provided that
-              component is not real (because it might be in the wrong
+			 * the component is not real (because it might be in
-              place. */
+			 * the wrong place. */
-          if (name(bse) == name_tag && isvar(son(bse)) &&
+			if (name(bse) == name_tag && isvar(son(bse)) &&
-                !isglob(son(bse)) &&
+			    !isglob(son(bse)) &&
-                name(sh(son(son(bse)))) >= shrealhd &&
+			    name(sh(son(son(bse)))) >= shrealhd &&
-                name(sh(son(son(bse)))) <= doublehd)  {
+			    name(sh(son(son(bse)))) <= doublehd) {
-            setvis(son(bse));
+				setvis(son(bse));
-            props(e) = (prop)(props(e) & ~0x08);
+				props(e) = (prop)(props(e) & ~0x08);
-          };
+			}
-          sh(bse) = sh(e);
+			sh(bse) = sh(e);
 #ifdef NEWDIAGS
-	  if (diagnose)
+			if (diagnose) {
-	    dg_whole_comp (e, bse);
+				dg_whole_comp(e, bse);
+			}
 #endif
-          replace(e, bse, scope);
+			replace(e, bse, scope);
-          retcell(son(e));
+			retcell(son(e));
-          retcell(e);
+			retcell(e);
-          return 1;
+			return 1;
-        };
+		}
-       };
+	}
 #if replace_compound
-      if (in_proc_def)
+		if (in_proc_def) {
-      {  /* Provided that the exp is inside a procedure definition we
+			/* Provided that the exp is inside a procedure
-            always remove compound creation and replace it by a
+			 * definition we always remove compound creation and
-            variable declaration for the compound, assignments to
+			 * replace it by a variable declaration for the
-            the components, and deliver the compound. */
+			 * compound, assignments to the components, and deliver
+			 * the compound. */
-        shape she = sh(e);
+			shape she = sh(e);
-        exp var = me_start_clearvar(she, she);
+			exp var = me_start_clearvar(she, she);
-        exp cont = getexp(she, nilexp, 0, nilexp, nilexp, 0, 0, cont_tag);
+			exp cont = getexp(she, nilexp, 0, nilexp, nilexp, 0, 0,
+					  cont_tag);
-        exp_list el;
+			exp_list el;
-        exp obt;
+			exp obt;
-        exp t = son(e);
+			exp t = son(e);
-        exp seq;
+			exp seq;
-        obt = me_obtain(var);
+			obt = me_obtain(var);
-        son(cont) = obt;
+			son(cont) = obt;
-        setfather(cont, obt);
+			setfather(cont, obt);
-        el = new_exp_list(0);
+			el = new_exp_list(0);
-        while (1)
+			while (1) {
-         {
-           exp q = bro(t);  /* expression being assigned */
+				exp q = bro(t);	/* expression being assigned */
-           exp n = bro(q);
+				exp n = bro(q);
-           int end = (int)last(q);
+				int end = (int)last(q);
-           exp ass, p, ap;
+				exp ass, p, ap;
-           p = me_obtain(var);
+				p = me_obtain(var);
-	   if (name(sh(q)) != bitfhd || !newcode) {
+				if (name(sh(q)) != bitfhd || !newcode) {
+					/* destination */
-             ap = hold_check(f_add_to_ptr(p, t));  /* destination */
+					ap = hold_check(f_add_to_ptr(p, t));
-             ass = hold_check(f_assign(ap, q));
+					ass = hold_check(f_assign(ap, q));
-	   }
-	   else {
+				} else {
-	     ass = hold_check(f_bitfield_assign(p, t, q));
+					ass = hold_check(f_bitfield_assign(p, t,
+									   q));
-	   };
+				}
-           el = add_exp_list(el, ass, 0);
+				el = add_exp_list(el, ass, 0);
-           if (end)
+				if (end) {
-             break;
+					break;
+				}
-           t = n;
+				t = n;
-         };
+			}
-        seq = f_sequence(el, cont);
+			seq = f_sequence(el, cont);
 #ifdef NEWDIAGS
-	if (diagnose)
+			if (diagnose) {
-	  dg_whole_comp (e, var);
+				dg_whole_comp(e, var);
+			}
 #endif
-        replace(e, me_complete_id(var, seq), scope);
+			replace(e, me_complete_id(var, seq), scope);
-        retcell(e);
+			retcell(e);
-        return 1;
+			return 1;
-      };
+		}
 #endif
-      return 0;
+		return 0;
 #ifndef NEWDIAGS
-    case diagnose_tag:
+	case diagnose_tag:
 #endif
-    case prof_tag:
+	case prof_tag:
-      return 0;
+		return 0;
-    case ident_tag:
+	case ident_tag:
-      if (name(sh(son(e))) == bothd)
+		if (name(sh(son(e))) == bothd) {
-        {
-         exp s = son(e);
+			exp s = son(e);
-         exp b = bro(s);
+			exp b = bro(s);
 #ifdef NEWDIAGS
-	 if (diagnose) {
+			if (diagnose) {
-	   dg_dead_code (b, s);
+				dg_dead_code(b, s);
-	   dg_whole_comp (e, s);
+				dg_whole_comp(e, s);
-	 }
+			}
 #endif
-         kill_exp(b, b);
+			kill_exp(b, b);
-         replace(e, s, scope);
+			replace(e, s, scope);
-         retcell(e);
+			retcell(e);
-         return 1;
+			return 1;
-        };
+		}
 #if has_setcc
-      /* use if target has setcc instruction */
+		/* use if target has setcc instruction */
-      if (!is80x86 || is80586) {
+		if (!is80x86 || is80586) {
-	exp abst = absbool (e);
+			exp abst = absbool(e);
-	if (abst != nilexp &&
+			if (abst != nilexp &&
-		(!is80x86 || name(sh(son(abst))) <= u64hd)) {
+			    (!is80x86 || name(sh(son(abst))) <= u64hd)) {
-	  /* check if we can use setcc */
+				/* check if we can use setcc */
-	  exp a = copy (abst);
+				exp a = copy(abst);
-	  setname (a, absbool_tag);
+				setname(a, absbool_tag);
-	  pt (a) = nilexp;
+				pt(a) = nilexp;
-	  sh (a) = sh (e);
+				sh(a) = sh(e);
 #ifdef NEWDIAGS
-	  if (diagnose)
+				if (diagnose) {
-	    dg_whole_comp (e, a);
+					dg_whole_comp(e, a);
+				}
 #endif
-	  replace (e, a, a);
+				replace(e, a, a);
-	  kill_exp (e, e);
+				kill_exp(e, e);
-	  return (0);
+				return(0);
-	};
+			}
-      };
+		}
 #endif
-      if (name(sh(bro(son(e)))) != name(sh(e))) {
+		if (name(sh(bro(son(e)))) != name(sh(e))) {
-		sh(e) = sh(bro(son(e)));
+			sh(e) = sh(bro(son(e)));
-		IGNORE check_id(e,scope);
+			IGNORE check_id(e, scope);
-		return 1;
+			return 1;
-      }
+		}
-      return (check_id (e, scope));/* see check_id.c */
+		return (check_id (e, scope));	/* see check_id.c */
-    case seq_tag:
+	case seq_tag:
-      if (son (son (e)) == nilexp) {/* remove empty seq */
+		if (son(son(e)) == nilexp) {
+			/* remove empty seq */
-        exp s = son(e);
+			exp s = son(e);
-	sh(bro(s)) = sh(e);	/* unless bottom ???????????????????????????? */
+			sh(bro(s)) = sh(e);	/* unless bottom ? */
 #ifdef NEWDIAGS
-	if (diagnose)
+			if (diagnose) {
-	  dg_whole_comp (e, bro(s));
+				dg_whole_comp(e, bro(s));
+			}
 #endif
-	replace (e, bro (s), scope);
+			replace(e, bro(s), scope);
-        retcell(s);
+			retcell(s);
-	return (1);
+			return(1);
-      };
+		}
-      return (check_seq (e, scope));
+		return(check_seq(e, scope));
-    case cond_tag:
+	case cond_tag:
-      if (no (son (bro (son (e)))) == 0) {
+		if (no(son(bro(son(e)))) == 0) {
-	/* remove inaccessible statements */
+			/* remove inaccessible statements */
-	exp bs = bro(son(e));
+			exp bs = bro(son(e));
 #ifdef NEWDIAGS
-	if (diagnose) {
+			if (diagnose) {
-	  dg_dead_code (bro(son(bs)), son(e));
+				dg_dead_code(bro(son(bs)), son(e));
-	  dg_whole_comp (e, son(e));
+				dg_whole_comp(e, son(e));
-	}
+			}
 #endif
-	replace (e, son (e), scope);
+			replace(e, son(e), scope);
-	kill_exp(bs, scope);
+			kill_exp(bs, scope);
-	retcell(e);
+			retcell(e);
-	return (1);
+			return(1);
-      };
+		}
-      if (name (son (e)) == goto_tag &&
-	  pt (son (e)) == bro (son (e))) {
+		if (name(son(e)) == goto_tag && pt(son(e)) == bro(son(e))) {
-	/* replace cond which has first a simple goto to the alt by the
+			/* replace cond which has first a simple goto to the
-	   alt (removing the label) */
+			 * alt by the alt (removing the label) */
-	exp x = bro (son (bro (son (e))));
+			exp x = bro(son(bro(son(e))));
 #ifdef NEWDIAGS
-	if (diagnose) {
+			if (diagnose) {
-	  dg_rdnd_code (son(e), x);
+				dg_rdnd_code(son(e), x);
-	  dg_whole_comp (e, x);
+				dg_whole_comp(e, x);
-	}
+			}
 #endif
-	replace (e, x, scope);
+			replace(e, x, scope);
-        retcell(son (bro (son (e))));
+			retcell(son(bro(son(e))));
-	retcell(bro (son (e)));
+			retcell(bro(son(e)));
-        if (son(son(e)) != nilexp) { retcell(son(son(e))); }
+			if (son(son(e)) != nilexp) {
+				retcell(son(son(e)));
+			}
-        retcell(son(e));
+			retcell(son(e));
-        retcell(e);
+			retcell(e);
-	return (1);
+			return(1);
-      };
+		}
-      if (name (son (e)) == seq_tag && no (son (bro (son (e)))) == 1 &&
+		if (name(son(e)) == seq_tag && no(son(bro(son(e)))) == 1 &&
-	  name (bro (son (son (e)))) == goto_tag) {
+		    name(bro(son(son(e)))) == goto_tag) {
-	/* is e = cond(seq(..;goto m), l: x) and is only 1 use of l */
+			/* is e = cond(seq(..;goto m), l: x) and is only 1 use
+			 * of l */
-	exp t = son (son (son (e)));
+			exp t = son(son(son(e)));
-	while (!last (t))
+			while (!last(t)) {
-	  t = bro (t);
+				t = bro(t);
+			}
 #ifndef NEWDIAGS
-        if (name(t) == diagnose_tag)
+			if (name(t) == diagnose_tag) {
-          t = son(t);
+				t = son(t);
+			}
 #endif
-	if ((name (t) == test_tag || name (t) == testbit_tag) &&
+			if ((name(t) == test_tag || name(t) == testbit_tag) &&
-	    pt (t) == bro (son (e)) && test_number(t) <= 6) {
+			    pt(t) == bro(son(e)) && test_number(t) <= 6) {
-	  /* look at last element of sequence before goto m to see if it
+				/* look at last element of sequence before goto
+				 * m to see if it is a conditional jump to l.
-	     is a conditional jump to l. If so reverse the test, make it
+				 * If so reverse the test, make it jump to m
-	     jump to m and remove the goto */
+				 * and remove the goto */
-	  settest_number (t, revtest[test_number (t) - 1]);
+				settest_number(t, revtest[test_number(t) - 1]);
-	  pt (t) = pt (bro (son (son (e))));
+				pt(t) = pt(bro(son(son(e))));
-	  sh (son (e)) = sh (bro (son (bro (son (e)))));
+				sh(son(e)) = sh(bro(son(bro(son(e)))));
-	  replace (bro (son (son (e))),
+				replace(bro(son(son(e))), bro(son(bro(son(e)))),
-	      bro (son (bro (son (e)))),
-	      son (e));
+					son(e));
-	  replace (e, son (e), scope);
+				replace(e, son(e), scope);
-	  retcell (e);
+				retcell(e);
-	  return (1);
+				return(1);
-	};
+			}
+		}
-      };
 #if maxmin_implemented
-      {
+		{
-	exp t;
+			exp t;
-	int bl = is_maxop(e, &t);
+			int bl = is_maxop(e, &t);
-	int ismax = 0;
+			int ismax = 0;
-	int ismin = 0;
+			int ismin = 0;
-	ntest nt;
+			ntest nt;
-	if (bl) {
+			if (bl) {
-	  nt = test_number(t);
+				nt = test_number(t);
+				if (nt == f_greater_than ||
-	  if (nt == f_greater_than || nt == f_greater_than_or_equal) {
+				    nt == f_greater_than_or_equal) {
-	    ismax = 1;
+					ismax = 1;
-	  };
+				}
+				if (nt == f_less_than ||
-	  if (nt == f_less_than || nt == f_less_than_or_equal)
+				    nt == f_less_than_or_equal) {
-	    ismin = 1;
+					ismin = 1;
-	}
+				}
-	else {
+			} else {
-	  bl = is_minop(e, &t);
+				bl = is_minop(e, &t);
-	  if (bl) {
+				if (bl) {
-	    nt = test_number(t);
+					nt = test_number(t);
+					if (nt == f_greater_than ||
-	    if (nt == f_greater_than || nt == f_greater_than_or_equal)
+					    nt == f_greater_than_or_equal) {
-	      ismin = 1;
+						ismin = 1;
+					}
+					if (nt == f_less_than ||
-	    if (nt == f_less_than || nt == f_less_than_or_equal)
+					    nt == f_less_than_or_equal) {
-	      ismax = 1;
+						ismax = 1;
+					}
-	  };
+				}
-	};
+			}
-	if (ismax || ismin) {
+			if (ismax || ismin) {
-	  exp tq = me_b2(copy(son(t)), copy(bro(son(t))),
+				exp tq = me_b2(copy(son(t)), copy(bro(son(t))),
-			 (ismax)
+					       (ismax) ?
-			   ? (unsigned char)max_tag
+					       (unsigned char)max_tag :
-			   : (unsigned char)min_tag);
+					       (unsigned char)min_tag);
-	  replace(e, hold_check(tq), scope);
+				replace(e, hold_check(tq), scope);
-	  kill_exp(e, e);
+				kill_exp(e, e);
-	  return 1;
+				return 1;
-	};
+			}
-      };
+		}
 #endif
+#if condassign_implemented
+		{
+			exp to_test;
+			exp to_ass;
+			if (is_condassign(e, &to_test, &to_ass) &&
+			    is_floating(name(sh(son(to_test)))) ==
+			    is_floating(name(sh(bro(son(to_ass)))))) {
+				exp res = me_b3(sh(e), to_test, to_ass,
-#if condassign_implemented
+						condassign_tag);
-      {
+				replace(e, res, scope);
-	exp to_test;
+				retcell(e);
-	exp to_ass;
+				return 1;
+			}
+		}
+#endif
-	if (is_condassign(e, &to_test, &to_ass) &&
+		if (name(bro(son(bro(son(e))))) == top_tag) {
+			exp first = son(e);
+			exp alt = bro(first);
+			int in_repeat = 0;
+			if (crt_repeat != nilexp &&
-	       is_floating(name(sh(son(to_test)))) ==
+			    (int)(props(crt_repeat)) == 1) {
+				in_repeat = 1;
+			}
-		 is_floating(name(sh(bro(son(to_ass)))))) {
+			if (take_out_of_line(first, alt, in_repeat, 1.0)) {
+				exp t = son(son(first));
-	  exp res = me_b3(sh(e), to_test, to_ass, condassign_tag);
+				exp tst = (is_tester(t, 0))? t : bro(son(t));
-	  replace(e, res, scope);
+				if (no(tst) == 1000) {
-	  retcell(e);
+					no(tst) = 25;
-	  return 1;
+				}
-	};
+			}
-      };
+		}
-#endif
+		return(0);
-      if (name(bro(son(bro(son(e))))) == top_tag) {
-        exp first = son(e);
-	exp alt = bro(first);
-	int in_repeat = 0;
-	if (crt_repeat != nilexp && (int)(props(crt_repeat)) == 1)
-	  in_repeat = 1;
-        if (take_out_of_line(first, alt, in_repeat, 1.0)) {
-	  exp t = son(son(first));
-	  exp tst = (is_tester(t, 0)) ? t : bro(son(t));
-	  if (no(tst) == 1000)
-	    no(tst) = 25;
-	}
-      }
-      return (0);
 #if condassign_implemented
-    case condassign_tag:
+	case condassign_tag:
-      if (name(bro(son(e))) != ass_tag &&
+		if (name(bro(son(e))) != ass_tag &&
+		    (name(son(e)) == test_tag ||
-	  (name(son(e)) == test_tag || name(son(e)) == testbit_tag)) {
+		     name(son(e)) == testbit_tag)) {
-	exp sqz = me_b3(f_top, son(son(e)), bro(son(son(e))), 0);
+			exp sqz = me_b3(f_top, son(son(e)), bro(son(son(e))),
+);
-	exp sq = me_b3(sh(e), sqz, bro(son(e)), seq_tag);
+			exp sq = me_b3(sh(e), sqz, bro(son(e)), seq_tag);
-	replace(e, hold_check(sq), scope);
+			replace(e, hold_check(sq), scope);
-	retcell(e);
+			retcell(e);
-	return 1;
+			return 1;
-      };
+		}
-      if (name(son(e)) == goto_tag) {
+		if (name(son(e)) == goto_tag) {
-	replace(e, getexp(f_top, nilexp, 0, nilexp,
+			replace(e, getexp(f_top, nilexp, 0, nilexp, nilexp, 0,
-			  nilexp, 0, 0, top_tag),
-	        scope);
+, top_tag), scope);
-	retcell(e);
+			retcell(e);
-	return 1;
+			return 1;
-      };
+		}
-      if (name(son(e)) == top_tag) {
+		if (name(son(e)) == top_tag) {
-	replace(e, bro(son(e)), scope);
+			replace(e, bro(son(e)), scope);
-	retcell(e);
+			retcell(e);
-	return 1;
+			return 1;
-      };
+		}
 #endif
+	case goto_tag:
-    case goto_tag: case return_to_label_tag: case trap_tag:
+	case return_to_label_tag:
+	case trap_tag:
-      return (0);
+		return(0);
-    case ass_tag:
+	case ass_tag:
 #if 0
-      if (0 && redo_structfns && !reg_result(sh(bro(son(e)))) &&
+		if (0 && redo_structfns && !reg_result(sh(bro(son(e)))) &&
-          name (bro (son (e))) == ident_tag &&
+		    name(bro(son(e))) == ident_tag &&
-	  isvar (bro (son (e)))) {  /* prepare to replace the assignment
+		    isvar (bro(son(e)))) {
-                                       of structure results of procedures.
+			/* prepare to replace the assignment of structure
-                                       If it decides to do so it will
+			 * results of procedures.  If it decides to do so it
-                                       put the destination in as the first
+			 * will put the destination in as the first parameter
-                                       parameter of the procedure */
+			 * of the procedure */
-	exp id = bro (son (e));
+			exp id = bro(son(e));
-	exp def = son (id);
+			exp def = son(id);
-	exp body = bro (def);
+			exp body = bro(def);
-	if (name (def) == clear_tag && name (body) == seq_tag) {
+			if (name(def) == clear_tag && name(body) == seq_tag) {
-	  if (name (son (son (body))) == apply_tag &&
+				if (name(son(son(body))) == apply_tag &&
-	      last (son (son (body))) &&
+				    last(son(son(body))) &&
-	      name (bro (son (body))) == cont_tag &&
+				    name(bro(son(body))) == cont_tag &&
-	      name (son (bro (son (body)))) == name_tag &&
+				    name(son(bro(son(body)))) == name_tag &&
-	      son (son (bro (son (body)))) == id) {
+				    son(son(bro(son(body)))) == id) {
-	    exp ap = son (son (body));
+					exp ap = son(son(body));
-	    exp p1 = bro (son (ap));
+					exp p1 = bro(son(ap));
-	    if (name (p1) == name_tag && son (p1) == id &&
+					if (name(p1) == name_tag &&
-		last (ap)) {
+					    son(p1) == id && last(ap)) {
-	      /* this is the assignment of a struct result of a proc */
+						/* this is the assignment of a
+						 * struct result of a proc */
-	      exp p2 = bro (son (ap));
+						exp p2 = bro(son(ap));
-	      exp se = son(e);
+						exp se = son(e);
-	      if (last(p2))
+						if (last(p2)) {
-		setlast (se);
+							setlast(se);
+						}
-              bro(se) = bro(p2);
+						bro(se) = bro(p2);
-              bro(son(ap)) = se;
+						bro(son(ap)) = se;
-	      if (name(se) == name_tag && isvar(son(se)) &&
+						if (name(se) == name_tag &&
+						    isvar(son(se)) &&
-		  !isglob(son(se)) &&
+						    !isglob(son(se)) &&
-		   shape_size(sh(id)) == shape_size(sh(son(son(se)))))
+						    shape_size(sh(id)) == shape_size(sh(son(son(se))))) {
-		setreallyass(se);
+							setreallyass(se);
+						}
-	      replace (e, ap, scope);
+						replace(e, ap, scope);
-	      return (1);
+						return(1);
-	    };
+					}
-	  };
+				}
-	};
+			}
-      };
+		}
 #endif
 #ifdef promote_pars
+		{
-	{ int x = al1_of(sh(son(e)))->al.sh_hd;
+			int x = al1_of(sh(son(e)))->al.sh_hd;
-	  if (x >= scharhd && x <= uwordhd && !little_end) {
+			if (x >= scharhd && x <= uwordhd && !little_end) {
-	        exp b = bro(son(e));
+				exp b = bro(son(e));
-		int disp = shape_size(ulongsh)-((x>=swordhd)?16:8);
+				int disp = shape_size(ulongsh) -
+				    ((x >= swordhd) ? 16 : 8);
-		exp r = getexp(f_pointer(f_alignment(sh(b))), nilexp,
+				exp r = getexp(f_pointer(f_alignment(sh(b))),
+					       nilexp, 1, son(e), nilexp, 0,
-, son(e), nilexp, 0, disp, reff_tag);
+					       disp, reff_tag);
-		bro(son(r)) = r; setlast(son(r));
+				bro(son(r)) = r; setlast(son(r));
-		r = hold_check(r);
+				r = hold_check(r);
-		bro(r) = b; clearlast(r);
+				bro(r) = b; clearlast(r);
-		son(e) = r;
+				son(e) = r;
-		return 1;
+				return 1;
-	  }
+			}
-	}
+		}
 #endif
-      return (seq_distr (e, scope));
+		return(seq_distr(e, scope));
-    case testbit_tag:
-      {
-	exp arg1 = son(e);
-	exp arg2 = bro(arg1);
-	if (name (arg1) == val_tag && name (arg2) == val_tag &&
-		!isbigval(arg1) && !isbigval(arg2)) {
-	  /* evaluate if args constant */
-	  int  k = no (arg1) & no (arg2);
-	  if ((k != 0 && test_number (e) == 5) ||
-                   (k == 0 && test_number (e) == 6))
-	    repbygo (e, pt (e), scope);
-	  else
-	    repbycont (e, 1, scope);
-	  return (1);
-	};
-	if (name(arg1) == shr_tag && name(arg2) == val_tag &&
-		name(bro(son(arg1))) == val_tag &&
-		!isbigval(arg2) && !isbigval(bro(son(arg1)))) {
-	  exp x = son(arg1);
-	  exp nsh = bro(x);
-	  int places = no(nsh);
-	  exp res;
-	  sh(x) = sh(arg2);
-	  res = me_b3(sh(e), x, me_shint(sh(arg2), no(arg2) << places),
-				testbit_tag);
-	  no(res) = no(e);
-	  pt(res) = pt(e);
-	  settest_number(res, test_number(e));
-	  replace(e, hold_check(res), scope);
-	  retcell(e);
-	  return 1;
-	};
-	return (0);
-      };
-    case test_tag: {
-	exp arg1, arg2;
-	int  n;
-	int bl;
-        unsigned char nt = test_number(e);
-	arg1 = son (e);
-	arg2 = bro (arg1);
+	case testbit_tag: {
+		exp arg1 = son(e);
+		exp arg2 = bro(arg1);
+		if (name(arg1) == val_tag && name(arg2) == val_tag &&
+		    !isbigval(arg1) && !isbigval(arg2)) {
+			/* evaluate if args constant */
+			int k = no(arg1) & no(arg2);
+			if ((k != 0 && test_number(e) == 5) ||
+			    (k == 0 && test_number(e) == 6)) {
+				repbygo(e, pt(e), scope);
+			} else {
+				repbycont(e, 1, scope);
+			}
+			return(1);
+		}
+		if (name(arg1) == shr_tag && name(arg2) == val_tag &&
+		    name(bro(son(arg1))) == val_tag &&
+		    !isbigval(arg2) && !isbigval(bro(son(arg1)))) {
+			exp x = son(arg1);
+			exp nsh = bro(x);
+			int places = no(nsh);
+			exp res;
+			sh(x) = sh(arg2);
+			res = me_b3(sh(e), x,
+				    me_shint(sh(arg2), no(arg2) << places),
+				    testbit_tag);
+			no(res) = no(e);
+			pt(res) = pt(e);
+			settest_number(res, test_number(e));
+			replace(e, hold_check(res), scope);
+			retcell(e);
+			return 1;
+		}
+		return(0);
+	}
+	case test_tag: {
+		exp arg1, arg2;
+		int n;
+		int bl;
+		unsigned char nt = test_number(e);
+		arg1 = son(e);
+		arg2 = bro(arg1);
-        if (flpt_always_comparable ||
+		if (flpt_always_comparable ||
-             (name(sh(arg1)) < shrealhd || name(sh(arg1)) > doublehd)) {
+		    (name(sh(arg1)) < shrealhd || name(sh(arg1)) > doublehd)) {
-          switch (nt) {
+			switch (nt) {
+			case 7:
-            case 7: nt = f_greater_than;
+				nt = f_greater_than;
-		    break;
+				break;
+			case 8:
-            case 8: nt = f_greater_than_or_equal;
+				nt = f_greater_than_or_equal;
-		    break;
+				break;
+			case 9:
-            case 9: nt = f_less_than;
+				nt = f_less_than;
-		    break;
+				break;
+			case 10:
-            case 10: nt = f_less_than_or_equal;
+				nt = f_less_than_or_equal;
-		     break;
+				break;
+			case 11:
-            case 11: nt = f_not_equal;
+				nt = f_not_equal;
-		     break;
+				break;
+			case 12:
-            case 12: nt = f_equal;
+				nt = f_equal;
-		     break;
+				break;
+			case 13:
-            case 13: repbycont (e, 1, scope);
+				repbycont(e, 1, scope);
-		     return 1;
+				return 1;
+			case 14:
-            case 14: repbygo (e, pt (e), scope);
+				repbygo(e, pt(e), scope);
-		     return 1;
+				return 1;
-	    default: break;
+			default:
-          };
+				break;
-        };
+			}
+		}
-	settest_number(e, nt);
+		settest_number(e, nt);
 		/* evaluate constant expressions */
-	if ((name (arg1) == val_tag || name (arg1) == null_tag) &&
+		if ((name(arg1) == val_tag || name(arg1) == null_tag) &&
-	    (name (arg2) == val_tag || name (arg2) == null_tag)) {
+		    (name(arg2) == val_tag || name(arg2) == null_tag)) {
-	  /* see if we know which way to jump and replace by unconditional
+			/* see if we know which way to jump and replace by
-	     goto or nop. For integers. */
+			 * unconditional goto or nop. For integers. */
-	  int c = docmp_f ((int)test_number (e), arg1, arg2);
+			int c = docmp_f((int)test_number(e), arg1, arg2);
-	  if (c)
+			if (c) {
-	    repbycont (e, 1, scope);
+				repbycont(e, 1, scope);
-	  else
+			} else {
-	    repbygo (e, pt (e), scope);
+				repbygo(e, pt(e), scope);
+			}
-	  return (1);
+			return(1);
-	};
+		}
-        if (test_number (e) >= 5 &&
+		if (test_number(e) >= 5 &&
-            ((name(arg1) == null_tag && no(arg1) == 0 &&
+		    ((name(arg1) == null_tag && no(arg1) == 0 &&
-		name(arg2) == name_tag &&
+		      name(arg2) == name_tag && isvar(son(arg2))) ||
-		isvar(son(arg2))) ||
-            (name(arg2) == null_tag && no(arg2) == 0 &&
+		     (name(arg2) == null_tag && no(arg2) == 0 &&
-		name(arg1) == name_tag &&
+		      name(arg1) == name_tag && isvar(son(arg1))))) {
-		isvar(son(arg1)))))  {
-		/* if we are comparing null with a variable we
+			/* if we are comparing null with a variable we
-		   know the way to jump. */
+			   know the way to jump. */
-          if (test_number(e) == 6)
+			if (test_number(e) == 6) {
-             repbycont(e, 1, scope);
+				repbycont(e, 1, scope);
-          else
+			} else {
-             repbygo(e, pt(e), scope);
+				repbygo(e, pt(e), scope);
+			}
-          return 1;
+			return 1;
-        };
+		}
-	if (name (arg1) == real_tag && name (arg2) == real_tag &&
+		if (name(arg1) == real_tag && name(arg2) == real_tag &&
-	     test_number(e) <= 6) {
+		    test_number(e) <= 6) {
-	  /* similar for reals */
+			/* similar for reals */
-	  if (cmpflpt (no (arg1), no (arg2), (int)(test_number (e))))
+			if (cmpflpt(no(arg1), no(arg2),
+				    (int)(test_number(e)))) {
-	    repbycont (e, 1, scope);
+				repbycont(e, 1, scope);
-	  else
+			} else {
-	    repbygo (e, pt (e), scope);
+				repbygo(e, pt(e), scope);
+			}
-	  return (1);
+			return(1);
-	};
+		}
 		/* end of constant expression evaluation */
-	if (name(arg1) == val_tag || name(arg1) == real_tag ||
-		name(arg1) == null_tag) {
-		/* constant argument always second */
-	  son(e) = arg2;
-	  bro(arg2) = arg1;
-	  bro(arg1) = e;
-	  setlast(arg1);
-	  clearlast(arg2);
-	  arg2 = arg1;
-	  arg1 = son(e);
-	  nt = exchange_ntest[nt];
-	  settest_number(e, nt);
-	};
+		if (name(arg1) == val_tag || name(arg1) == real_tag ||
+		    name(arg1) == null_tag) {
+			/* constant argument always second */
+			son(e) = arg2;
+			bro(arg2) = arg1;
+			bro(arg1) = e;
+			setlast(arg1);
+			clearlast(arg2);
+			arg2 = arg1;
+			arg1 = son(e);
+			nt = exchange_ntest[nt];
+			settest_number(e, nt);
+		}
-	if (name (arg1) == chvar_tag && name (arg2) == chvar_tag &&
+		if (name(arg1) == chvar_tag && name(arg2) == chvar_tag &&
-	    name (sh (son (arg1))) == name (sh (son (arg2))) &&
+		    name(sh(son(arg1))) == name(sh(son(arg2))) &&
-	    shape_size (sh (son (arg1))) <= shape_size (sh (arg1)) &&
+		    shape_size(sh(son(arg1))) <= shape_size(sh(arg1)) &&
 #if only_lengthen_ops
-	    shape_size(sh (arg1)) >= 16 &&
+		    shape_size(sh(arg1)) >= 16 &&
 #endif
-	    (is_signed(sh (son (arg1))) == is_signed(sh (arg1)))
+		    (is_signed(sh(son(arg1))) == is_signed(sh(arg1)))) {
-	  ) {
-	  exp ee;
+			exp ee;
 #if is80x86 || ishppa
-	/* optimise if both args are result of sign extension removal */
+			/* optimise if both args are result of sign extension
+			 * removal */
-	    if ((test_number(e) == f_equal ||
+			if ((test_number(e) == f_equal ||
-			 test_number(e) == f_not_equal) &&
+			     test_number(e) == f_not_equal) &&
-		name(sh(arg1)) == slonghd &&
+			    name(sh(arg1)) == slonghd &&
-		name(son(arg1)) == cont_tag &&
+			    name(son(arg1)) == cont_tag &&
-		name(son(arg2)) == cont_tag &&
+			    name(son(arg2)) == cont_tag &&
-		shape_size(sh (son(arg1))) == 16 &&
+			    shape_size(sh(son(arg1))) == 16 &&
-		name(son(son(arg1))) == name_tag &&
+			    name(son(son(arg1))) == name_tag &&
-		name(son(son(arg2))) == name_tag) {
+			    name(son(son(arg2))) == name_tag) {
-	      exp dec1 = son(son(son(arg1)));
+				exp dec1 = son(son(son(arg1)));
-	      exp dec2 = son(son(son(arg2)));
+				exp dec2 = son(son(son(arg2)));
-	      if (isse_opt(dec1) && isse_opt(dec2)) {
+				if (isse_opt(dec1) && isse_opt(dec2)) {
-		son(e) = son(arg1);
+					son(e) = son(arg1);
-		sh(son(arg1)) = slongsh;
+					sh(son(arg1)) = slongsh;
-		clearlast(son(arg1));
+					clearlast(son(arg1));
-		bro(son(arg1)) = son(arg2);
+					bro(son(arg1)) = son(arg2);
-		sh(son(arg2)) = slongsh;
+					sh(son(arg2)) = slongsh;
-		setlast(son(arg2));
+					setlast(son(arg2));
-		bro(son(arg2)) = e;
+					bro(son(arg2)) = e;
-		return 0;
+					return 0;
-	      };
+				}
-	    };
+			}
 #endif
-	  /* arrange to do test in smallest size integers by removing
+			/* arrange to do test in smallest size integers by
-	     chvar and altering shape of test args */
+			 * removing chvar and altering shape of test args */
-	  ee = copyexp (e);
+			ee = copyexp(e);
-	  son (ee) = son (arg1);
+			son(ee) = son(arg1);
-	  bro (son (arg1)) = son (arg2);
+			bro(son(arg1)) = son(arg2);
-	  clearlast (son (arg1));
+			clearlast(son(arg1));
-	  replace (e, hc (ee, bro (son (ee))), scope);
+			replace(e, hc(ee, bro(son(ee))), scope);
-	  retcell (arg1);
+			retcell(arg1);
-	  retcell (arg2);
+			retcell(arg2);
-	  retcell (e);
+			retcell(e);
-	  return (1);
+			return(1);
-	};
+		}
 #if little_end & has_byte_ops
 #ifdef NEWDIAGS
-	    if (diagnose)
+				if (diagnose) {
-	      dg_dead_code (bro(son(q)), t);
+					dg_dead_code(bro(son(q)), t);
+				}
 #endif
-	    kill_exp (q, q);
+				kill_exp(q, q);
-	    looping = !last(t);
+				looping = !last(t);
-	  }
-	  else {
+			} else {
-	    looping = !last (bro (t));
+				looping = !last(bro(t));
-	    t = bro (t);
+				t = bro(t);
-	  };
-	}
+			}
-	while (looping);
+		} while (looping);
-	if (last (son (e))) {
+		if (last(son(e))) {
 #ifdef NEWDIAGS
-	  if (diagnose)
+			if (diagnose) {
-	    dg_whole_comp (e, son(e));
+				dg_whole_comp(e, son(e));
+			}
 #endif
-	  replace (e, copy(son (e)), scope);
+			replace(e, copy(son(e)), scope);
-	  kill_exp(e,e);
+			kill_exp(e, e);
+			return(1);
+		}
+		if (changed) {
-	  return (1);
+			return(1);
+		}
+		return(0);
-	};
+	}
+	case case_tag:
+		if (name(son(e)) == val_tag) {
+			/* if we know the case argument select the right case
+			 * branch and replace by goto. Knock on effect will be
+			 * to eliminate dead code. */
+			exp n = son(e);
+			int changed = 0;
+			exp t = son(e);
+			exp z;
+			do {
+				exp up;
+				t = bro(t);
+				if (son(t) == nilexp) {
+					up = t;
+				} else {
+					up = son(t);
+				}
+				if (docmp_f((int)f_less_than_or_equal, t, n) &&
+				    docmp_f((int)f_less_than_or_equal, n, up)) {
+					changed = 1;
+					z = pt(t);
+				}
+				/*	  else
+					  --no(son(pt(t)));
+				 */
+			} while (!last(t));
+			if (!changed) {
+				repbycont(e, 0, scope);
+			} else {
+				SET(z);
+				repbygo(e, z, scope);
+			}
+			return(1);
+		}
+		return(0);
+	case rep_tag:
+	case apply_general_tag:
+	case set_stack_limit_tag:
+	case give_stack_limit_tag:
+	case env_size_tag:
+	case apply_tag:
+	case res_tag:
+	case goto_lv_tag:
+	case assvol_tag:
+	case local_free_all_tag:
+	case local_free_tag:
+	case last_local_tag:
+	case long_jump_tag:
+	case movecont_tag:
+		return(0);
+	case alloca_tag:
+		if (name(son(e)) == chvar_tag &&
+		    name(sh(son(son(e)))) == ulonghd) {
+			replace(son(e), son(son(e)), son(e));
+		}
+		return(0);
+	case nof_tag:
+	case labst_tag:
+		return 0;
+	case concatnof_tag: {
+		exp a1 = son(e);
+		exp a2 = bro(a1);
+		exp r;
+		nat n;
+		if (name(a1) == string_tag && name(a2) == string_tag) {
+			/* apply if args constant */
+			char *s1 = nostr(son(e));
+			char *s2 = nostr(bro(son(e)));
+			/* note NOT zero termination convention !! */
+			int sz1, sz2, i;
+			char *newstr;
+			char *p2;
+			shape newsh;
+			sz1 = shape_size(sh(son(e))) / 8;
+			sz2 = shape_size(sh(bro(son(e)))) / 8;
+			newstr = (char *)xcalloc((sz1 + sz2), sizeof(char));
+			p2 = &newstr[sz1];
+			nat_issmall(n) = 1;
+			natint(n) = sz1 + sz2;
+			newsh = f_nof(n, scharsh);
+			for (i = 0; i < sz1; ++i) {
+				newstr[i] = s1[i];
+			}
+			for (i = 0; i < sz2; ++i) {
+				p2[i] = s2[i];
+			}
+			r = getexp(newsh, nilexp, 0, nilexp, nilexp, 0, 0,
+				   string_tag);
+			nostr(r) = newstr;
+			replace(e, r, scope);
+			kill_exp(e, scope);
+			return(1);
+		}
+		return 0;
+	}
+	case ncopies_tag:
+	case ignorable_tag:
+		return 0;
-	if (changed)
+	case bfass_tag:
+	case bfassvol_tag: {
-	  return (1);
+		exp p = son(e);
-	return (0);
+		exp val = bro(p);
+		int bsz = shape_size(sh(val));
-      };
+		int rsz;
-    case case_tag:
+		int rsh;
-      if (name (son (e)) == val_tag ) {
+		int sg = is_signed(sh(val));
-	/* if we know the case argument select the right case branch and
-	   replace by goto. Knock on effect will be to eliminate dead
-	   code. */
+		int posmask;
-	exp  n = son (e);
+		int negmask;
-	int changed = 0;
+		int off = no(e);
-	exp t = son (e);
+		exp ref;
-	exp z;
+		exp cont;
-	do {
+		exp eshift;
-	  exp  up;
+		exp res;
-	  t = bro (t);
+		exp id;
-	  if (son (t) == nilexp)
+		exp idval;
-	    up = t;
+		shape ptr_sha;
-	  else
+		shape msh;
-	    up = son (t);
+		int temp = off + bsz - 1;
-	  if (docmp_f((int)f_less_than_or_equal, t, n) &&
-		docmp_f((int)f_less_than_or_equal, n, up)) {
-	    changed = 1;
-	    z = pt(t);
-	  }
-/*	  else
-	    --no (son (pt (t)));
-*/
-	}
-	while (!last (t));
-	if (!changed)
-	  repbycont (e, 0, scope);
-	else {
-	  SET(z);
-	  repbygo (e, z, scope);
-	};
-	return (1);
-      };
-      return (0);
-    case rep_tag:
-    case apply_general_tag:
-    case set_stack_limit_tag:
-    case give_stack_limit_tag:
-    case env_size_tag:
-    case apply_tag:
-    case res_tag:
-    case goto_lv_tag:
-    case assvol_tag:
-    case local_free_all_tag:
-    case local_free_tag:
-    case last_local_tag:
-    case long_jump_tag:
-    case movecont_tag:
-      return (0);
-    case alloca_tag:
-      if (name(son(e)) == chvar_tag && name(sh(son(son(e)))) == ulonghd) {
-	replace(son(e), son(son(e)), son(e));
-      };
-      return (0);
-    case nof_tag:
-    case labst_tag:
-      return 0;
-    case concatnof_tag:
-	{
-	  exp a1 = son (e);
-	  exp a2 = bro (a1);
-          exp r;
-          nat n;
-	  if (name (a1) == string_tag &&
-	      name (a2) == string_tag) {
-	    /* apply if args constant */
-	    char *s1 = nostr(son(e));
-	    char *s2 = nostr(bro(son(e)));
-	    /* note NOT zero termination convention !! */
-	    int  sz1,
-	          sz2,
-	          i;
-	    char * newstr;
-	    char * p2;
-	    shape newsh;
-	    sz1 = shape_size(sh(son(e)))/8;
-	    sz2 = shape_size(sh(bro (son (e))))/8;
-	    newstr = (char *) xcalloc ( (sz1 + sz2), sizeof (char));
-	    p2 = &newstr[sz1];
-            nat_issmall(n) = 1;
-            natint(n) = sz1+sz2;
-	    newsh = f_nof (n, scharsh);
-	    for (i = 0; i < sz1; ++i)
-	      newstr[i] = s1[i];
-	    for (i = 0; i < sz2; ++i)
-	      p2[i] = s2[i];
-            r = getexp (newsh, nilexp, 0, nilexp,
-		     nilexp, 0, 0, string_tag);
-            nostr(r) = newstr;
-	    replace (e, r, scope);
-	    kill_exp (e, scope);
-	    return (1);
-	  };
-	  return 0;
-	};
-    case ncopies_tag:
-    case ignorable_tag:
-	return 0;
-    case bfass_tag:
-    case bfassvol_tag:
-	{
-	  exp p = son(e);
-	  exp val = bro(p);
-	  int bsz = shape_size(sh(val));
-	  int rsz;
-	  int rsh;
-	  int sg = is_signed(sh(val));
-	  int posmask;
-	  int negmask;
-	  int off = no(e);
-	  exp ref;
-	  exp cont;
-	  exp eshift;
-	  exp res;
-	  exp id;
-	  exp idval;
-	  shape ptr_sha;
-	  shape msh;
-	  int temp = off + bsz - 1;
-	  if (((off/8) == (temp/8)) && bsz<=8
+		if (((off / 8) == (temp / 8)) && bsz <= 8
 #if 0
-		(bsz == 8 &&
+		    (bsz == 8 &&
-		    ((little_end && (off%8 == 0)) ||
+		     ((little_end && (off%8 == 0)) ||
 		      (!little_end && ((8 - (off % 8) - bsz) == 0))))
 #endif
-	        ) {
+		   ) {
-	    rsz = 8;
+			rsz = 8;
-	    if (sg)
+			if (sg) {
-	      msh = scharsh;
+				msh = scharsh;
-	    else
+			} else {
-	      msh = ucharsh;
+				msh = ucharsh;
-	  }
+			}
-	  else
-	  if (((off/16) == (temp/16)) && bsz <= 16
+		} else if (((off / 16) == (temp / 16)) && bsz <= 16
 #if 0
-	        (bsz == 16 &&
+			   (bsz == 16 &&
-		   ((little_end && (off%16 == 0)) ||
+			    ((little_end && (off%16 == 0)) ||
-		     (!little_end && ((16 - (off % 16) - bsz) == 0))))
+			     (!little_end && ((16 - (off % 16) - bsz) == 0))))
 #endif
-              ) {
+			  ) {
-	    rsz = 16;
+			rsz = 16;
-	    if (sg)
+			if (sg) {
-	      msh = swordsh;
+				msh = swordsh;
-	    else
+			} else {
-	      msh = uwordsh;
+				msh = uwordsh;
-	  }
+			}
-	  else
-	  if ((off/32) == (temp/32)) {
+		} else if ((off / 32) == (temp / 32)) {
-	    rsz = 32;
+			rsz = 32;
-	    if (sg)
+			if (sg) {
-	      msh = slongsh;
+				msh = slongsh;
-	    else
+			} else {
-	      msh = ulongsh;
+				msh = ulongsh;
-	  }
+			}
-	  else {
+		} else {
-	    rsz = 64;
+			rsz = 64;
-	    if (sg)
+			if (sg) {
-	      msh = s64sh;
+				msh = s64sh;
-	    else
+			} else {
-	      msh = u64sh;
+				msh = u64sh;
-	  };
+			}
+		}
-	  ptr_sha = f_pointer(long_to_al(rsz));
+		ptr_sha = f_pointer(long_to_al(rsz));
-	  if ((off / rsz) != 0) {
+		if ((off / rsz) != 0) {
-	    ref = me_u3(ptr_sha, p, reff_tag);
+			ref = me_u3(ptr_sha, p, reff_tag);
-	    no(ref) = (off / rsz) * rsz;
+			no(ref) = (off / rsz) * rsz;
-	    ref = hold_check(ref);
+			ref = hold_check(ref);
-	  }
-	  else
+		} else {
-	    ref = p;
+			ref = p;
+		}
-	  id = me_startid(f_top, ref, 0);
+		id = me_startid(f_top, ref, 0);
 #if little_end
-	  rsh = off % rsz;
+		rsh = off % rsz;
 #else
-	  rsh = rsz - (off % rsz) - bsz;
+		rsh = rsz - (off % rsz) - bsz;
 #endif
-	  posmask = (bsz == 32) ? -1 : (1 << bsz) -1;
+		posmask = (bsz == 32) ? -1 : (1 << bsz) -1;
-	  negmask = ~(posmask << rsh);
+		negmask = ~(posmask << rsh);
-	  cont = me_u3(msh, me_obtain(id),
+		cont = me_u3(msh, me_obtain(id), (name(e) == bfass_tag) ?
-		        (name(e) == bfass_tag)
-			  ? (unsigned char)cont_tag
+			     (unsigned char)cont_tag :
-			  : (unsigned char)contvol_tag);
+			     (unsigned char)contvol_tag);
-	  val = hold_check(me_u3(msh, val, chvar_tag));
+		val = hold_check(me_u3(msh, val, chvar_tag));
-	  val = hold_check(me_b3(msh, val,
+		val = hold_check(me_b3(msh, val, me_shint(msh, posmask),
-				 me_shint(msh, posmask), and_tag));
+				       and_tag));
-	  if (rsh != 0)
+		if (rsh != 0) {
-	    eshift =
-	     hold_check(me_b3(msh, val, me_shint(slongsh, rsh), shl_tag));
+			eshift = hold_check(me_b3(msh, val, me_shint(slongsh,
+								rsh), shl_tag));
-	  else {
+		} else {
-	    eshift = val;
+			eshift = val;
-	    sh(eshift) = msh;
+			sh(eshift) = msh;
-	  };
+		}
-	  idval = me_startid(f_top, eshift, 0);
+		idval = me_startid(f_top, eshift, 0);
-	  if (rsz != bsz) {
+		if (rsz != bsz) {
-	    cont = me_b3(msh, cont, me_shint(msh, negmask), and_tag);
+			cont = me_b3(msh, cont, me_shint(msh, negmask),
+				     and_tag);
-	    cont = hold_check(me_b3(msh, cont, me_obtain(idval), or_tag));
+			cont = hold_check(me_b3(msh, cont, me_obtain(idval),
-	  }
+						or_tag));
-	  else {
+		} else {
-	    kill_exp(cont, cont);
+			kill_exp(cont, cont);
-	    cont = me_obtain(idval);
+			cont = me_obtain(idval);
-	  };
+		}
-	  res = me_b3(f_top, me_obtain(id), cont,
+		res = me_b3(f_top, me_obtain(id), cont,
-		      (name(e) == bfass_tag)
-		        ? (unsigned char)ass_tag
+			    (name(e) == bfass_tag) ? (unsigned char)ass_tag :
-			: (unsigned char)assvol_tag);
+			    (unsigned char)assvol_tag);
-	  res = hold_check(me_complete_id(idval, res));
+		res = hold_check(me_complete_id(idval, res));
-	  replace(e, hold_check(me_complete_id(id, res)), scope);
+		replace(e, hold_check(me_complete_id(id, res)), scope);
-	  retcell(e);
+		retcell(e);
-	  return 1;
+		return 1;
-	};
+	}
-    default:
+	default:
-      return (0);
+		return(0);
-  }
+	}
+}

Subversion Repositories tendra.SVN

(root)/branches/tendra5/src/installers/common/construct/check.c – Rev 5 → 6