WebSVN – tendra.SVN – Diff – /trunk/src/installers/common/construct/flpt_fns.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
+ *
 ***********************************************************************/
-  /* This file consists of the floating point and complex operations
+/* This file consists of the floating point and complex operations
-     extracted from install_fns.c, to reduce compilation unit sizes
+   extracted from install_fns.c, to reduce compilation unit sizes */
-  */
 #include "config.h"
 #include <ctype.h>
 #include <time.h>
 #include "common_types.h"
 #include "readglob.h"
 #include "case_opt.h"
 #include "install_fns.h"
 #include "externs.h"
 extern shape shcomplexsh;
 extern shape complexsh;
 extern shape complexdoublesh;
-exp_list reorder_list PROTO_S ( ( exp_list, int ) ) ;
+exp_list reorder_list(exp_list, int);
-exp me_contents PROTO_S ( ( exp ) ) ;
+exp me_contents(exp);
-extern int eq_et PROTO_S ( ( error_treatment, error_treatment ) ) ;
+extern int eq_et(error_treatment, error_treatment);
-extern exp TDFcallaux PROTO_S ( ( error_treatment, exp, char *, shape ) ) ;
+extern exp TDFcallaux(error_treatment, exp, char *, shape);
-extern exp find_named_tg PROTO_S ( ( char *, shape ) ) ;
+extern exp find_named_tg(char *, shape);
-static exp me_complete_chain PROTO_S ( ( exp, exp, exp ) ) ;
-static exp push PROTO_S ( ( exp, exp ) ) ;
-static void square_x_iy PROTO_S ( ( error_treatment, exp *, exp *, exp ) ) ;
-static void mult_w_by_z PROTO_S ( ( error_treatment, exp *, exp *, exp, exp, exp ) ) ;
-static exp make_comp_1_z PROTO_S ( ( floating_variety, error_treatment, exp, exp, exp, exp, exp, exp ) ) ;
-static exp f_bin_floating_plus PROTO_S ( ( error_treatment, exp, exp ) ) ;
-static exp f_bin_floating_mult PROTO_S ( ( error_treatment, exp, exp ) ) ;
-static exp real_power PROTO_S ( ( error_treatment, exp, exp ) ) ;
+static exp me_complete_chain(exp, exp, exp);
+static exp push(exp, exp);
+static void square_x_iy(error_treatment, exp *, exp *, exp);
+static void mult_w_by_z(error_treatment, exp *, exp *, exp, exp, exp);
+static exp make_comp_1_z(floating_variety, error_treatment, exp, exp, exp, exp,
+			 exp, exp);
+static exp f_bin_floating_plus(error_treatment, exp, exp);
+static exp f_bin_floating_mult(error_treatment, exp, exp);
+static exp real_power(error_treatment, exp, exp);
+exp
-exp f_change_floating_variety
+f_change_floating_variety(error_treatment flpt_err, floating_variety r,
-    PROTO_N ( (flpt_err, r, arg1) )
+			  exp arg1)
-    PROTO_T ( error_treatment flpt_err X floating_variety r X exp arg1 )
+{
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
     return arg1;
+  }
 #if check_shape
-  if ( ! ( (is_complex(sh(arg1)) && is_complex(f_floating(r)) ) ||
+  if (!((is_complex(sh(arg1)) && is_complex(f_floating(r))) ||
-	   (is_float(sh(arg1)) && is_float(f_floating(r)) )
+	(is_float(sh(arg1)) && is_float(f_floating(r))))) {
-	 )
-     )
     failer(CHSH_CHFL);
+  }
 #endif
- if (eq_shape(f_floating(r), sh(arg1)))		/* i.e. does nothing */
+ if (eq_shape(f_floating(r), sh(arg1))) {	/* i.e. does nothing */
     return arg1;	/* Discard the other bits ? */
+ }
 #if substitute_complex
-  if (is_complex(sh(arg1)))
+  if (is_complex(sh(arg1))) {
-  {
     shape complex_shape = sh(arg1);
-    floating_variety real_fv = f_float_of_complex (f_floating(r));
+    floating_variety real_fv = f_float_of_complex(f_floating(r));
-    exp c1 = me_startid (complex_shape, arg1, 0);
+    exp c1 = me_startid(complex_shape, arg1, 0);
     exp obtain1_c1 = me_obtain(c1);		/* contents of arg1 */
     exp obtain2_c1 = me_obtain(c1);
-    exp x = f_real_part      (obtain1_c1);		/* re(arg1) */
+    exp x = f_real_part(obtain1_c1);		/* re(arg1) */
-    exp y = f_imaginary_part (obtain2_c1);		/* im(arg1) */
+    exp y = f_imaginary_part(obtain2_c1);	/* im(arg1) */
-    exp new_x = f_change_floating_variety (flpt_err, real_fv, x);
+    exp new_x = f_change_floating_variety(flpt_err, real_fv, x);
-    exp new_y = f_change_floating_variety (flpt_err, real_fv, y);
+    exp new_y = f_change_floating_variety(flpt_err, real_fv, y);
-    exp make_comp = f_make_complex (r, new_x, new_y);
+    exp make_comp = f_make_complex(r, new_x, new_y);
-    c1 = me_complete_id (c1, make_comp);		/* Does a 'hold_check' */
+    c1 = me_complete_id(c1, make_comp);	/* Does a 'hold_check' */
     return c1;
-  };
+  }
 #endif  /* substitute complex */
 #if ishppa
+  {
     exp t = me_c1(f_floating(r), flpt_err, arg1, chfl_tag);
-    if (!optop(t) && name(sh(t))==doublehd) {
+    if (!optop(t) && name(sh(t)) == doublehd) {
-      exp id = me_startid(sh(t),t,0);
+      exp id = me_startid(sh(t), t, 0);
-      exp tmp = me_complete_id(id,me_obtain(id));
+      exp tmp = me_complete_id(id, me_obtain(id));
       return tmp;
-     }
-    else
+     } else {
       return t;
+     }
+  }
 #endif
   return me_c1(f_floating(r), flpt_err, arg1, chfl_tag);
+}
-exp f_complex_conjugate
+exp
-    PROTO_N ( (arg1) )
-    PROTO_T ( exp arg1 )
+f_complex_conjugate(exp arg1)
+{
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
     return arg1;
+  }
 #if check_shape
-  if (!is_complex(sh(arg1)))
+  if (!is_complex(sh(arg1))) {
     failer(CHSH_CONJUGATE);
+  }
 #endif
 #if substitute_complex
+  {
-    shape complex_shape = sh(arg1);                     /* shape of our complex numbers */
+    shape complex_shape = sh(arg1);	/* shape of our complex numbers */
     floating_variety real_fv = f_float_of_complex(complex_shape);
     shape real_shape = f_floating(real_fv);
     floating_variety complex_fv = f_complex_of_float(real_shape);
     exp c1 = me_startid(complex_shape, arg1, 0);
-    exp obtain1_c1 = hold_check(me_obtain(c1));                     /* contents of arg1 */
+    exp obtain1_c1 = hold_check(me_obtain(c1));		/* contents of arg1 */
     exp obtain2_c1 = hold_check(me_obtain(c1));
-    exp x1 = f_real_part(obtain1_c1);                                       /* re(arg1) */
+    exp x1 = f_real_part(obtain1_c1);			/* re(arg1) */
-    exp y1 = f_imaginary_part(obtain2_c1);                                  /* im(arg1) */
+    exp y1 = f_imaginary_part(obtain2_c1);		/* im(arg1) */
-    exp neg_im = f_floating_negate(f_impossible, y1);                           /* - im(arg1) */
+    exp neg_im = f_floating_negate(f_impossible, y1);	/* - im(arg1) */
     exp make_comp = f_make_complex(complex_fv, x1, neg_im);
     c1 = me_complete_id(c1, make_comp);
     return c1;
   return me_u3(sh(arg1), arg1, conj_tag);
 #endif
+}
-exp f_float_int
+exp
-    PROTO_N ( (flpt_err, f, arg1) )
-    PROTO_T ( error_treatment flpt_err X floating_variety f X exp arg1 )
+f_float_int(error_treatment flpt_err, floating_variety f, exp arg1)
+{
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
     return arg1;
+  }
 #if check_shape
-  if (!is_integer(sh(arg1)))
+  if (!is_integer(sh(arg1))) {
     failer(CHSH_FLINT);
+  }
 #endif
     if (is_complex(f_floating(f))) {
 	flpt fzero_copy = new_flpt();
 	floating_variety fv = f_float_of_complex(f_floating(f));
 	shape real_shape = f_floating(fv);
 	exp zero;
 	exp res = f_float_int(flpt_err, fv, arg1);
 	res = hold_check(res);
-	flt_copy (flptnos[fzero_no], &flptnos[fzero_copy]);
+	flt_copy(flptnos[fzero_no], &flptnos[fzero_copy]);
-	zero = getexp(real_shape, nilexp, 1, nilexp, nilexp, 0,
+	zero = getexp(real_shape, nilexp, 1, nilexp, nilexp, 0, fzero_copy,
-			fzero_copy,  real_tag);
+		      real_tag);
 	return f_make_complex(f, res, zero);
+    }
 #if !has64bits
-  if ((name(arg1)!=val_tag || flpt_err.err_code > 2)
+  if ((name(arg1) != val_tag || flpt_err.err_code > 2) &&
-		 && shape_size(sh(arg1))> 32) {
+      shape_size(sh(arg1)) > 32) {
 #if use_long_double
-	exp z = TDFcallaux(flpt_err, arg1,
+	exp z = TDFcallaux(flpt_err, arg1, (is_signed(sh(arg1)) ?
-		(is_signed(sh(arg1))?"__TDFUs_float":"__TDFUu_float"), doublesh);
+					    "__TDFUs_float" : "__TDFUu_float"),
+			   doublesh);
 	z = hold_check(z);
 	if (f != doublefv) {
 		z = me_c1(f_floating(f), flpt_err, z, chfl_tag);
+	}
 	return z;
 #else
-	exp z = TDFcallaux(flpt_err, arg1,
+	exp z = TDFcallaux(flpt_err, arg1, (is_signed(sh(arg1)) ?
-		(is_signed(sh(arg1))?"__TDFUs_float":"__TDFUu_float"), realsh);
+					    "__TDFUs_float" : "__TDFUu_float"),
+			   realsh);
 	z = hold_check(z);
 	if (f != realfv) {
 		z = me_c1(f_floating(f), flpt_err, z, chfl_tag);
+	}
 	return z;
 #endif
   return me_c1(f_floating(f), flpt_err, arg1, float_tag);
+}
-exp f_floating_abs
+exp
-    PROTO_N ( (ov_err, arg1) )
-    PROTO_T ( error_treatment ov_err X exp arg1 )
+f_floating_abs(error_treatment ov_err, exp arg1)
+{
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
     return arg1;
+  }
 #if check_shape
-  if (!is_float(sh(arg1)))
+  if (!is_float(sh(arg1))) {
     failer(CHSH_FLABS);
+  }
 #endif
 #if ishppa
+  {
     exp r = me_u1(ov_err, arg1, fabs_tag);
-    if (!optop(r) && name(sh(r))==doublehd) {
+    if (!optop(r) && name(sh(r)) == doublehd) {
-      exp id = me_startid(sh(r),r,0);
+      exp id = me_startid(sh(r), r, 0);
-      exp tmp = me_complete_id(id,me_obtain(id));
+      exp tmp = me_complete_id(id, me_obtain(id));
       return tmp;
-     }
-    else
+     } else {
       return r;
+     }
+  }
 #endif
   return me_u1(ov_err, arg1, fabs_tag);
+}
-exp f_floating_div
+exp
-    PROTO_N ( (ov_err, arg1, arg2) )
-    PROTO_T ( error_treatment ov_err X exp arg1 X exp arg2 )
+f_floating_div(error_treatment ov_err, exp arg1, exp arg2)
+{
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
-    { kill_exp(arg2,arg2); return arg1; }
+    kill_exp(arg2, arg2);
+    return arg1;
+  }
-  if (name(sh(arg2)) == bothd)
+  if (name(sh(arg2)) == bothd) {
-    { kill_exp(arg1,arg1); return arg2; }
+    kill_exp(arg1, arg1);
+    return arg2;
+  }
 #if check_shape
-  if (! ((is_float(sh(arg1)) || is_complex(sh(arg1))) && eq_shape(sh(arg1), sh(arg2))) )
+  if (!((is_float(sh(arg1)) || is_complex(sh(arg1))) &&
+	eq_shape(sh(arg1), sh(arg2)))) {
     failer(CHSH_FLDIV);
+  }
 #endif
 /* PAB changes - 21 October 1994 */
 #if substitute_complex
   if (is_complex(sh(arg1))) {
-      shape complex_shape = sh(arg1);                     /* shape of our complex numbers */
+      shape complex_shape = sh(arg1);	/* shape of our complex numbers */
       floating_variety real_fv = f_float_of_complex(complex_shape);
       shape real_shape = f_floating(real_fv);
       floating_variety complex_fv = f_complex_of_float(real_shape);
       exp z1 = me_startid(complex_shape, arg1, 0);
       exp z2 = me_startid(complex_shape, arg2, 0);
-      exp obtain1_z1 = hold_check(me_obtain(z1));                     /* contents of arg1 */
+      exp obtain1_z1 = hold_check(me_obtain(z1));	/* contents of arg1 */
       exp obtain2_z1 = hold_check(me_obtain(z1));
-      exp obtain1_z2 = hold_check(me_obtain(z2));                     /* contents of arg2 */
+      exp obtain1_z2 = hold_check(me_obtain(z2));	/* contents of arg2 */
       exp obtain2_z2 = hold_check(me_obtain(z2));
-      exp z1_re = f_real_part(obtain1_z1);                           /* re(arg1) */
+      exp z1_re = f_real_part(obtain1_z1);		/* re(arg1) */
-      exp z2_re = f_real_part(obtain1_z2);                           /* re(arg2) */
+      exp z2_re = f_real_part(obtain1_z2);		/* re(arg2) */
-      exp z1_im = f_imaginary_part(obtain2_z1);                      /* im(arg1) */
+      exp z1_im = f_imaginary_part(obtain2_z1);		/* im(arg1) */
-      exp z2_im = f_imaginary_part(obtain2_z2);                      /* im(arg2) */
+      exp z2_im = f_imaginary_part(obtain2_z2);		/* im(arg2) */
       exp x1 = me_startid(real_shape, z1_re, 0);
       exp x2 = me_startid(real_shape, z2_re, 0);
       exp y1 = me_startid(real_shape, z1_im, 0);
       exp y2 = me_startid(real_shape, z2_im, 0);
-      exp obtain1_x1 = hold_check(me_obtain(x1));                     /* x1 is used twice */
+      exp obtain1_x1 = hold_check(me_obtain(x1)); /* x1 is used twice */
       exp obtain2_x1 = hold_check(me_obtain(x1));
-      exp obtain1_y1 = hold_check(me_obtain(y1));                     /* y1 is used twice */
+      exp obtain1_y1 = hold_check(me_obtain(y1)); /* y1 is used twice */
       exp obtain2_y1 = hold_check(me_obtain(y1));
-      exp obtain1_x2 = hold_check(me_obtain(x2));                /* x2 is used four times */
+      exp obtain1_x2 = hold_check(me_obtain(x2)); /* x2 is used four times */
       exp obtain2_x2 = hold_check(me_obtain(x2));
       exp obtain3_x2 = hold_check(me_obtain(x2));
       exp obtain4_x2 = hold_check(me_obtain(x2));
-      exp obtain1_y2 = hold_check(me_obtain(y2));                /* y2 is used four times */
+      exp obtain1_y2 = hold_check(me_obtain(y2)); /* y2 is used four times */
       exp obtain2_y2 = hold_check(me_obtain(y2));
       exp obtain3_y2 = hold_check(me_obtain(y2));
       exp obtain4_y2 = hold_check(me_obtain(y2));
       exp mult_x2_x2 = f_bin_floating_mult(ov_err, obtain1_x2, obtain2_x2);
       exp mult_y2_y2 = f_bin_floating_mult(ov_err, obtain1_y2, obtain2_y2);
       exp mult_x1_x2 = f_bin_floating_mult(ov_err, obtain1_x1, obtain3_x2);
       exp mult_y1_y2 = f_bin_floating_mult(ov_err, obtain1_y1, obtain3_y2);
       exp mult_y1_x2 = f_bin_floating_mult(ov_err, obtain2_y1, obtain4_x2);
       exp mult_x1_y2 = f_bin_floating_mult(ov_err, obtain2_x1, obtain4_y2);
-      exp plus1  = f_bin_floating_plus(ov_err, mult_x2_x2, mult_y2_y2);
+      exp plus1 = f_bin_floating_plus(ov_err, mult_x2_x2, mult_y2_y2);
-      exp plus2  = f_bin_floating_plus(ov_err, mult_x1_x2, mult_y1_y2);
+      exp plus2 = f_bin_floating_plus(ov_err, mult_x1_x2, mult_y1_y2);
       exp minus1 = f_floating_minus(ov_err, mult_y1_x2, mult_x1_y2);
       exp denom = me_startid(real_shape, plus1, 0);
       exp obtain_denom1 = hold_check(me_obtain(denom));
       exp obtain_denom2 = hold_check(me_obtain(denom));
-      exp answer_re = f_floating_div(ov_err, plus2,  obtain_denom1);
+      exp answer_re = f_floating_div(ov_err, plus2, obtain_denom1);
       exp answer_im = f_floating_div(ov_err, minus1, obtain_denom2);
       exp make_comp = f_make_complex(complex_fv, answer_re, answer_im);
       denom = me_complete_id(denom, make_comp);
       y2 = me_complete_id(y2, denom);
       x1 = me_complete_id(x1, x2);
       z2 = me_complete_id(z2, x1);
       z1 = me_complete_id(z1, z2);
       return z1;
-  };
+  }
 #endif
 #if ishppa
+  {
     exp r = hold_check(me_b1(ov_err, arg1, arg2, fdiv_tag));
-    if (!optop(r) && name(sh(r))==doublehd) {
+    if (!optop(r) && name(sh(r)) == doublehd) {
-      exp id = me_startid(sh(r),r,0);
+      exp id = me_startid(sh(r), r, 0);
-      exp tmp = me_complete_id(id,me_obtain(id));
+      exp tmp = me_complete_id(id, me_obtain(id));
       return tmp;
-     }
-    else
+     } else {
       return r;
+     }
   }
+#endif
+  return hold_check(me_b1(ov_err, arg1, arg2, fdiv_tag));
+}
+exp
+f_floating_maximum(error_treatment flpt_err, exp arg1, exp arg2)
+{
+  if (name(sh(arg1)) == bothd) {
+    kill_exp(arg2, arg2);
+    return arg1;
+  }
+  if (name(sh(arg2)) == bothd) {
+    kill_exp(arg1, arg1);
+    return arg2;
+  }
+#if check_shape
+  if (!is_float(sh(arg1)) || !eq_shape(sh(arg1), sh(arg2))) {
+    failer(CHSH_FLMAX);
+  }
 #endif
-  return  hold_check(me_b1(ov_err, arg1, arg2, fdiv_tag));
+  return hold_check(me_b1(flpt_err, arg1, arg2, fmax_tag));
+}
-exp f_floating_maximum
+exp
-    PROTO_N ( (flpt_err, arg1, arg2) )
-    PROTO_T ( error_treatment flpt_err X exp arg1 X exp arg2 )
+f_floating_minimum(error_treatment flpt_err, exp arg1, exp arg2)
+{
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
-    { kill_exp(arg2,arg2); return arg1; }
+    kill_exp(arg2, arg2);
+    return arg1;
+  }
-  if (name(sh(arg2)) == bothd)
+  if (name(sh(arg2)) == bothd) {
-    { kill_exp(arg1,arg1); return arg2; }
+    kill_exp(arg1, arg1);
+    return arg2;
+  }
 #if check_shape
-  if (!is_float(sh(arg1)) || !eq_shape(sh(arg1), sh(arg2)))
+  if (!is_float(sh(arg1)) || !eq_shape(sh(arg1), sh(arg2))) {
-    failer(CHSH_FLMAX);
-#endif
-  return  hold_check(me_b1(flpt_err, arg1, arg2, fmax_tag));
-}
-exp f_floating_minimum
-    PROTO_N ( (flpt_err, arg1, arg2) )
-    PROTO_T ( error_treatment flpt_err X exp arg1 X exp arg2 )
-{
-  if (name(sh(arg1)) == bothd)
-    { kill_exp(arg2,arg2); return arg1; }
-  if (name(sh(arg2)) == bothd)
-    { kill_exp(arg1,arg1); return arg2; }
-#if check_shape
-  if (!is_float(sh(arg1)) || !eq_shape(sh(arg1), sh(arg2)))
     failer(CHSH_FLMIN);
+  }
 #endif
-  return  hold_check(me_b1(flpt_err, arg1, arg2, fmin_tag));
+  return hold_check(me_b1(flpt_err, arg1, arg2, fmin_tag));
 }
 /****************************************************************/
 /*  The following code needs to generate labels for use with    */
 /*  'cond_tag'.  This is currently implemented using the        */
 /*  knowledge that a label can be obtained by taking a pointer  */
 /*  hack is performed exclusively by the MACRO 'make_label'     */
 /****************************************************************/
 #define make_label(EXP) &EXP
 /************************************************/
 /*  'is_constant_arg' checks to see if E1 is    */
 /*   a constant that will fit into type 'int'.  */
 /************************************************/
-#define is_constant_arg(E1) \
+#define is_constant_arg(E1)\
 	((name(E1) == val_tag) && !isbigval(E1) && \
 	(is_signed(sh(E1)) || (no(E1) >> 31 == 0)))
-exp f_floating_power
+exp
-    PROTO_N ( (ov_err, arg1, arg2) )
-    PROTO_T ( error_treatment ov_err X exp arg1 X exp arg2 )
+f_floating_power(error_treatment ov_err, exp arg1, exp arg2)
 {
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
-    { kill_exp(arg2,arg2); return arg1; }
+    kill_exp(arg2,arg2);
+    return arg1;
+  }
-  if (name(sh(arg2)) == bothd)
+  if (name(sh(arg2)) == bothd) {
-    { kill_exp(arg1,arg1); return arg2; }
+    kill_exp(arg1,arg1);
+    return arg2;
+  }
 #if check_shape
-  if (!( (is_float(sh(arg1)) || is_complex(sh(arg1))) && is_integer(sh(arg2)) ))
+  if (!((is_float(sh(arg1)) || is_complex(sh(arg1))) &&
+	is_integer(sh(arg2)))) {
     failer(CHSH_FLPOWER);
+  }
 #endif
 /* PAB changes - 31 October 1994 */
   /* Gives shorter .s file if n<10 and arg1 is unknown */
   if (is_complex(sh(arg1))) {
       shape integer_shape = sh(arg2);
-      shape complex_shape = sh(arg1);                     /* shape of our complex numbers */
+      shape complex_shape = sh(arg1);	/* shape of our complex numbers */
       floating_variety real_fv = f_float_of_complex(complex_shape);
       shape real_shape = f_floating(real_fv);
       floating_variety complex_fv = f_complex_of_float(real_shape);
       exp sn = me_startid(integer_shape, arg2, 0);
       if (is_constant_arg(arg2) ||
 	((name(arg2) == name_tag) && (name(son(arg2)) == ident_tag)
-	   && !isvar(son(arg2)) && is_constant_arg(son(son(arg2)))))
+	   && !isvar(son(arg2)) && is_constant_arg(son(son(arg2))))) {
-      {                                                              /* we know the power */
+	  /* we know the power */
 	  int n;
 	  int exponent;
-	  exp z = push (sn, me_startid(complex_shape, arg1, 0));
+	  exp z = push(sn, me_startid(complex_shape, arg1, 0));
 	  if (is_constant_arg(arg2)) {
 	      exponent = no(arg2);	/* arg2 is a constant */
-	  }
-	  else {
+	  } else {
 	      exponent = no(son(son(arg2)));
-		  /* arg2 identifies a constant */
+	      /* arg2 identifies a constant */
+	  }
 	  n = abs(exponent);
 	  if (n == 0) {
-	      exp  answer_re, answer_im, make_comp;
+	      exp answer_re, answer_im, make_comp;
 	      flpt fzero_copy = new_flpt();
-	      flpt fone_copy  = new_flpt();
+	      flpt fone_copy = new_flpt();
-	      flt_copy (flptnos[fzero_no], &flptnos[fzero_copy]);
-	      flt_copy (flptnos[fone_no],  &flptnos[fone_copy]);
-	      answer_re = getexp(real_shape, nilexp, 1, nilexp, nilexp, 0, fone_copy,  real_tag);
-	      answer_im = getexp(real_shape, nilexp, 1, nilexp, nilexp, 0, fzero_copy, real_tag);
-	      make_comp = f_make_complex(complex_fv, answer_re, answer_im);
-	      return  me_complete_chain(z, arg2, make_comp);
+	      flt_copy(flptnos[fzero_no], &flptnos[fzero_copy]);
+	      flt_copy(flptnos[fone_no], &flptnos[fone_copy]);
+	      answer_re = getexp(real_shape, nilexp, 1, nilexp, nilexp, 0,
+				 fone_copy, real_tag);
+	      answer_im = getexp(real_shape, nilexp, 1, nilexp, nilexp, 0,
+				 fzero_copy, real_tag);
+	      make_comp = f_make_complex(complex_fv, answer_re, answer_im);
+	      return me_complete_chain(z, arg2, make_comp);
 	  } else {
 	      exp link_next;
-	      exp z_re = f_real_part     (me_obtain(z));
+	      exp z_re = f_real_part(me_obtain(z));
 	      exp z_im = f_imaginary_part(me_obtain(z));
-	      exp x = push (z, me_startid(real_shape, z_re, 0));
-	      exp y = push (x, me_startid(real_shape, z_im, 0));
+	      exp x = push(z, me_startid(real_shape, z_re, 0));
+	      exp y = push(x, me_startid(real_shape, z_im, 0));
 	      exp u, v, mylast;;
 	      while ((n % 2) == 0) {
 		  mylast = y;
 		  square_x_iy(ov_err, &x, &y, mylast);
 		  n = n / 2;
+	      }
-	      if (n == 1) {                                                   /* return z */
+	      if (n == 1) {
+		  /* return z */
 		  if (exponent < 0) {
 		      link_next = make_comp_1_z(complex_fv, ov_err,
-						me_obtain(x), me_obtain(x), me_obtain(x),
+						me_obtain(x), me_obtain(x),
+						me_obtain(x), me_obtain(y),
-						me_obtain(y), me_obtain(y), me_obtain(y));
+						me_obtain(y), me_obtain(y));
 		  } else {
-		      link_next = f_make_complex(complex_fv, me_obtain(x), me_obtain(y));
+		      link_next = f_make_complex(complex_fv, me_obtain(x),
+						 me_obtain(y));
 		  }
-		  return me_complete_chain(y, arg2, link_next);             /*  return z  */
-	      } else {                           	                       /*  w = z  */
+		  return me_complete_chain(y, arg2, link_next); /*  return z  */
+	      } else {
+		  /*  w = z  */
-		  u = push (y, me_startid(real_shape, me_obtain(x), 0));
+		  u = push(y, me_startid(real_shape, me_obtain(x), 0));
-		  v = push (u, me_startid(real_shape, me_obtain(y), 0));
+		  v = push(u, me_startid(real_shape, me_obtain(y), 0));
 		  mylast = v;
+	      }
 	      while (n != 1) {
+		  /*  z = z*z  */
-		  square_x_iy(ov_err, &x, &y, mylast);                         /*  z = z*z  */
+		  square_x_iy(ov_err, &x, &y, mylast);
 		  mylast = y;
 		  n = n / 2;
 		  if ((n % 2) == 1) {
+		      /*  w = w*z  */
-		      mult_w_by_z (ov_err, &u, &v, x, y, mylast);              /*  w = w*z  */
+		      mult_w_by_z (ov_err, &u, &v, x, y, mylast);
 		      mylast = v;
+		  }
 	      }
 	      if (exponent < 0) {
 		  link_next = make_comp_1_z(complex_fv, ov_err,
-					    me_obtain(u), me_obtain(u), me_obtain(u),
+					    me_obtain(u), me_obtain(u),
+					    me_obtain(u), me_obtain(v),
-					    me_obtain(v), me_obtain(v), me_obtain(v));
+					    me_obtain(v), me_obtain(v));
 	      } else {
 		  link_next = f_make_complex(complex_fv, me_obtain(u), me_obtain(v));
+	      }
+	      /* return w */
-	      return me_complete_chain(v, arg2, link_next);                /*  return w  */
+	      return me_complete_chain(v, arg2, link_next);
+	  }
       } else {
+	  /* main building blocks */
-	  exp  reinitialise_w, main_loop, make_comp;              /* main building blocks */
+	  exp reinitialise_w, main_loop, make_comp;
-	  exp  square_z, mult_z_w, half_n, update_w, repeat_body;
+	  exp square_z, mult_z_w, half_n, update_w, repeat_body;
-	  exp  seq, seq_zero, make_comp1, make_comp2;
+	  exp seq, seq_zero, make_comp1, make_comp2;
-	  exp  real0, real1, x, y, u, v;
+	  exp real0, real1, x, y, u, v;
-	  exp z  = me_startid(complex_shape, arg1, 0);
+	  exp z = me_startid(complex_shape, arg1, 0);
 	  exp abs_val_sn = f_abs(ov_err, me_obtain(sn));
 	  exp n = me_startid(sh(sn), abs_val_sn, 1);
-	  exp z_re = f_real_part     (me_obtain(z));
+	  exp z_re = f_real_part(me_obtain(z));
 	  exp z_im = f_imaginary_part(me_obtain(z));
 	  flpt fzero_copy = new_flpt();
-	  flpt fone_copy  = new_flpt();
+	  flpt fone_copy = new_flpt();
-	  flt_copy (flptnos[fzero_no], &flptnos[fzero_copy]);
+	  flt_copy(flptnos[fzero_no], &flptnos[fzero_copy]);
-	  flt_copy (flptnos[fone_no],  &flptnos[fone_copy]);
+	  flt_copy(flptnos[fone_no], &flptnos[fone_copy]);
-	  real0 = getexp(real_shape, nilexp, 1, nilexp, nilexp, 0, fzero_copy, real_tag);
+	  real0 = getexp(real_shape, nilexp, 1, nilexp, nilexp, 0, fzero_copy,
+			 real_tag);
-	  real1 = getexp(real_shape, nilexp, 1, nilexp, nilexp, 0, fone_copy,  real_tag);
+	  real1 = getexp(real_shape, nilexp, 1, nilexp, nilexp, 0, fone_copy,
+			 real_tag);
-	  x = me_startid(real_shape, z_re, 1);                                /* re(arg1) */
+	  x = me_startid(real_shape, z_re, 1);	/* re(arg1) */
-	  y = me_startid(real_shape, z_im, 1);                                /* re(arg2) */
+	  y = me_startid(real_shape, z_im, 1);	/* re(arg2) */
-	  u = me_startid(real_shape, real1, 1);                            /* re(w) = 1.0 */
+	  u = me_startid(real_shape, real1, 1);	/* re(w) = 1.0 */
-	  v = me_startid(real_shape, real0, 1);                            /* im(w) = 0.0 */
+	  v = me_startid(real_shape, real0, 1);	/* im(w) = 0.0 */
 	  /*  change value of w to z if n is odd  */
 	  {
-	      exp constant1  = me_shint(integer_shape, 1);
+	      exp constant1 = me_shint(integer_shape, 1);
-	      exp constant2  = me_shint(integer_shape, 2);
+	      exp constant2 = me_shint(integer_shape, 2);
-	      exp rem_n_2    = f_rem0 (f_impossible, f_impossible,
+	      exp rem_n_2 = f_rem0(f_impossible, f_impossible, me_contents(n),
-				       me_contents(n), constant2);
+				   constant2);
-	      exp assign_u = hold_check(me_b3(f_top, me_obtain(u), me_contents(x), ass_tag));
+	      exp assign_u = hold_check(me_b3(f_top, me_obtain(u),
+					      me_contents(x), ass_tag));
-	      exp assign_v = hold_check(me_b3(f_top, me_obtain(v), me_contents(y), ass_tag));
+	      exp assign_v = hold_check(me_b3(f_top, me_obtain(v),
+					      me_contents(y), ass_tag));
-	      exp top_cell  = me_l1(f_top, top_tag);
+	      exp top_cell = me_l1(f_top, top_tag);
-	      exp alt_labst = hold_check(me_b3(sh(top_cell), me_null(f_top,0,clear_tag),
+	      exp alt_labst = hold_check(me_b3(sh(top_cell),
+					       me_null(f_top, 0, clear_tag),
 					       top_cell, labst_tag));
-	      exp is_n_odd = f_integer_test (no_nat_option, f_equal,
+	      exp is_n_odd = f_integer_test(no_nat_option, f_equal,
-					     make_label(alt_labst), rem_n_2, constant1);
+					    make_label(alt_labst), rem_n_2,
+					    constant1);
 	      exp seq_zero = hold_check(me_b2(is_n_odd, assign_u, 0));
-	      exp seq = hold_check(me_b3(sh(assign_v), seq_zero, assign_v, seq_tag));
+	      exp seq = hold_check(me_b3(sh(assign_v), seq_zero, assign_v,
+					 seq_tag));
-	      reinitialise_w = hold_check(me_b3(lub_shape(sh(seq),sh(alt_labst)),
+	      reinitialise_w = hold_check(me_b3(lub_shape(sh(seq),
+							  sh(alt_labst)),
 						seq, alt_labst, cond_tag));
+	  }
 	  /*  z=z*z  */
+	  {
-	      exp minus_x_y = f_floating_minus(ov_err, me_contents(x), me_contents(y));
+	      exp minus_x_y = f_floating_minus(ov_err, me_contents(x),
+					       me_contents(y));
-	      exp  plus_x_y = f_bin_floating_plus(ov_err, me_contents(x), me_contents(y));
+	      exp  plus_x_y = f_bin_floating_plus(ov_err, me_contents(x),
+						  me_contents(y));
-	      exp  mult_x_y = f_bin_floating_mult(ov_err, me_contents(x), me_contents(y));
+	      exp  mult_x_y = f_bin_floating_mult(ov_err, me_contents(x),
+						  me_contents(y));
 	      exp tmp = me_startid(real_shape, mult_x_y, 0);
-	      exp answer_re  = f_bin_floating_mult(ov_err, minus_x_y, plus_x_y);
+	      exp answer_re = f_bin_floating_mult(ov_err, minus_x_y, plus_x_y);
-	      exp answer_im  = f_bin_floating_plus(ov_err, me_obtain(tmp), me_obtain(tmp));
+	      exp answer_im = f_bin_floating_plus(ov_err, me_obtain(tmp),
+						   me_obtain(tmp));
-	      exp assign_x = hold_check(me_b3(f_top, me_obtain(x), answer_re, ass_tag));
+	      exp assign_x = hold_check(me_b3(f_top, me_obtain(x), answer_re,
+					      ass_tag));
-	      exp assign_y = hold_check(me_b3(f_top, me_obtain(y), answer_im, ass_tag));
+	      exp assign_y = hold_check(me_b3(f_top, me_obtain(y), answer_im,
+					      ass_tag));
 	      exp seq_zero = hold_check(me_u2(assign_x, 0));
-	      exp seq      = hold_check(me_b3(sh(assign_y), seq_zero, assign_y, seq_tag));
+	      exp seq = hold_check(me_b3(sh(assign_y), seq_zero, assign_y,
+					 seq_tag));
 	      square_z = me_complete_id(tmp, seq);
+	  }
 	  /*  w=z*w  */
 	  {
-	      exp mult_x_u = f_bin_floating_mult(ov_err, me_contents(x), me_contents(u));
+	      exp mult_x_u = f_bin_floating_mult(ov_err, me_contents(x),
+						 me_contents(u));
-	      exp mult_x_v = f_bin_floating_mult(ov_err, me_contents(x), me_contents(v));
+	      exp mult_x_v = f_bin_floating_mult(ov_err, me_contents(x),
+						 me_contents(v));
-	      exp mult_y_u = f_bin_floating_mult(ov_err, me_contents(y), me_contents(u));
+	      exp mult_y_u = f_bin_floating_mult(ov_err, me_contents(y),
+						 me_contents(u));
-	      exp mult_y_v = f_bin_floating_mult(ov_err, me_contents(y), me_contents(v));
+	      exp mult_y_v = f_bin_floating_mult(ov_err, me_contents(y),
+						 me_contents(v));
 	      exp tmp = me_startid(real_shape, mult_y_u, 0);
-	      exp answer_re  = f_floating_minus(ov_err, mult_x_u, mult_y_v);
+	      exp answer_re = f_floating_minus(ov_err, mult_x_u, mult_y_v);
-	      exp answer_im  = f_bin_floating_plus(ov_err, mult_x_v, me_obtain(tmp));
+	      exp answer_im = f_bin_floating_plus(ov_err, mult_x_v,
+						  me_obtain(tmp));
-	      exp assign_u = hold_check(me_b3(f_top, me_obtain(u), answer_re, ass_tag));
+	      exp assign_u = hold_check(me_b3(f_top, me_obtain(u), answer_re,
+					      ass_tag));
-	      exp assign_v = hold_check(me_b3(f_top, me_obtain(v), answer_im, ass_tag));
+	      exp assign_v = hold_check(me_b3(f_top, me_obtain(v), answer_im,
+					      ass_tag));
 	      exp seq_zero = hold_check(me_u2(assign_u, 0));
-	      exp seq      = hold_check(me_b3(sh(assign_v), seq_zero, assign_v, seq_tag));
+	      exp seq = hold_check(me_b3(sh(assign_v), seq_zero, assign_v,
+					 seq_tag));
 	      mult_z_w = me_complete_id(tmp, seq);
+	  }
-	  /*  n=n/2  */
+	  /*  n = n / 2  */
+	  {
+	      exp constant2 = me_shint(integer_shape, 2);
+	      exp answer = f_div0(f_impossible, f_impossible, me_contents(n),
+				  constant2);
+	      half_n = hold_check(me_b3(f_top, me_obtain(n), answer, ass_tag));
+	  }
+	  /*  if n is odd then w = z * w  */
+	  {
+	      exp constant1 = me_shint(integer_shape, 1);
-	      exp constant2  = me_shint(integer_shape, 2);
+	      exp constant2 = me_shint(integer_shape, 2);
-	      exp answer = f_div0 (f_impossible, f_impossible,
-				   me_contents(n), constant2);
-	      half_n = hold_check(me_b3(f_top, me_obtain(n), answer, ass_tag));
-	  }
-	  /*  if n is odd then w = z*w  */
-	  {
-	      exp constant1  = me_shint(integer_shape, 1);
-	      exp constant2  = me_shint(integer_shape, 2);
-	      exp rem_n_2    = f_rem0 (f_impossible, f_impossible,
+	      exp rem_n_2 = f_rem0(f_impossible, f_impossible, me_contents(n),
-				       me_contents(n), constant2);
+				   constant2);
-	      exp top_cell  = me_l1(f_top, top_tag);
+	      exp top_cell = me_l1(f_top, top_tag);
-	      exp alt_labst = hold_check(me_b3(f_top, me_null(f_top,0,clear_tag),
+	      exp alt_labst = hold_check(me_b3(f_top, me_null(f_top, 0,
+							      clear_tag),
 					       top_cell, labst_tag));
-	      exp is_n_odd = f_integer_test (no_nat_option, f_equal,
+	      exp is_n_odd = f_integer_test(no_nat_option, f_equal,
-					     make_label(alt_labst), rem_n_2, constant1);
+					    make_label(alt_labst), rem_n_2,
+					    constant1);
 	      exp seq_zero = hold_check(me_u2(is_n_odd, 0));
-	      exp seq = hold_check(me_b3(sh(mult_z_w), seq_zero, mult_z_w, seq_tag));
+	      exp seq = hold_check(me_b3(sh(mult_z_w), seq_zero, mult_z_w,
+					 seq_tag));
-	      update_w = hold_check(me_b3(lub_shape(sh(seq),sh(alt_labst)),
+	      update_w = hold_check(me_b3(lub_shape(sh(seq), sh(alt_labst)),
 					  seq, alt_labst, cond_tag));
+	  }
 	  /*  repeat + body  */
+	  {
 	      exp if_n_equals_1, seq_zero, seq, body_labst;
-	      exp constant1  = me_shint(integer_shape, 1);
+	      exp constant1 = me_shint(integer_shape, 1);
-	      exp top_cell   = me_l1(f_top, top_tag);
+	      exp top_cell = me_l1(f_top, top_tag);
-	      body_labst = hold_check(me_b3(sh(top_cell), me_null(f_top,0,clear_tag),
+	      body_labst = hold_check(me_b3(sh(top_cell),
+					    me_null(f_top, 0, clear_tag),
-                                            top_cell, labst_tag));
+					    top_cell, labst_tag));
-	      if_n_equals_1 = f_integer_test (no_nat_option, f_equal, make_label(body_labst),
+	      if_n_equals_1 = f_integer_test(no_nat_option, f_equal,
+					     make_label(body_labst),
-					      me_contents(n), constant1);
+					     me_contents(n), constant1);
 	      seq_zero = me_b2(square_z, update_w, 0);
-	      setbro (square_z, half_n);                   /*  insert half_n between   */
+	      setbro(square_z, half_n);	/*  insert half_n between   */
-	      setbro (half_n, update_w);                   /*  square_x and update_w   */
+	      setbro(half_n, update_w);	/*  square_x and update_w   */
-	      clearlast (half_n);
+	      clearlast(half_n);
 	      seq_zero = hold_check(seq_zero);
-	      seq = hold_check(me_b3(sh(if_n_equals_1), seq_zero, if_n_equals_1, seq_tag));
+	      seq = hold_check(me_b3(sh(if_n_equals_1), seq_zero,
+				     if_n_equals_1, seq_tag));
 	      setbro(son(body_labst), seq);
 	      clearlast(son(body_labst));
 	      setfather(body_labst, seq);
-	      repeat_body = hold_check(me_b3(sh(seq), top_cell, body_labst, rep_tag));
+	      repeat_body = hold_check(me_b3(sh(seq), top_cell, body_labst,
+					     rep_tag));
 	      note_repeat(repeat_body);
+	  }
 	  /*  make loop - only done if  mod(n) > 1  */
+	  {
-	      exp constant1  = me_shint(integer_shape, 1);
+	      exp constant1 = me_shint(integer_shape, 1);
-	      exp top_cell  = me_l1(f_top, top_tag);
+	      exp top_cell = me_l1(f_top, top_tag);
-	      exp alt_labst = hold_check(me_b3(f_top, me_null(f_top,0,clear_tag),
+	      exp alt_labst = hold_check(me_b3(f_top,
+					       me_null(f_top, 0, clear_tag),
 					       top_cell, labst_tag));
-	      exp is_n_gt_1 = f_integer_test (no_nat_option, f_greater_than,
+	      exp is_n_gt_1 = f_integer_test(no_nat_option, f_greater_than,
+					     make_label(alt_labst),
-					      make_label(alt_labst), me_contents(n), constant1);
+					     me_contents(n), constant1);
 	      exp seq_zero = hold_check(me_u2(is_n_gt_1, 0));
-	      exp seq = hold_check(me_b3(sh(repeat_body), seq_zero, repeat_body, seq_tag));
+	      exp seq = hold_check(me_b3(sh(repeat_body), seq_zero,
+					 repeat_body, seq_tag));
 	      main_loop = hold_check(me_b3(lub_shape(sh(seq),sh(alt_labst)),
 					   seq, alt_labst, cond_tag));
 	  }
-	  make_comp1 = f_make_complex(complex_fv, me_contents(u), me_contents(v));
+	  make_comp1 = f_make_complex(complex_fv, me_contents(u),
+				      me_contents(v));
-	  make_comp2 = make_comp_1_z(complex_fv, ov_err,
+	  make_comp2 = make_comp_1_z(complex_fv, ov_err, me_contents(u),
-                                     me_contents(u), me_contents(u), me_contents(u),
+				     me_contents(u), me_contents(u),
-                                     me_contents(v), me_contents(v), me_contents(v));
+				     me_contents(v), me_contents(v),
+				     me_contents(v));
 	  /* if arg2 is negative then make_comp2 else make_comp1 */
+	  {
 	      exp constant0 = me_shint(integer_shape, 0);
 	      exp alt_labst = hold_check(me_b3(sh(make_comp1),
-					       me_null(f_top,0,clear_tag),
+					       me_null(f_top, 0, clear_tag),
 					       make_comp1, labst_tag));
-	      exp is_arg2_negative = f_integer_test (no_nat_option, f_less_than,
+	      exp is_arg2_negative = f_integer_test(no_nat_option, f_less_than,
-						     make_label(alt_labst),
+						    make_label(alt_labst),
-						     me_obtain(sn), constant0);
+						    me_obtain(sn), constant0);
 	      exp seq_zero = hold_check(me_u2(is_arg2_negative, 0));
-	      exp seq = hold_check(me_b3(sh(make_comp2), seq_zero, make_comp2, seq_tag));
+	      exp seq = hold_check(me_b3(sh(make_comp2), seq_zero, make_comp2,
+					 seq_tag));
 	      make_comp = hold_check(me_b3(lub_shape(sh(seq),sh(alt_labst)),
 					   seq, alt_labst, cond_tag));
+	  }
       seq_zero = hold_check(me_b2(reinitialise_w, main_loop, 0));
-      seq      = hold_check(me_b3(sh(make_comp), seq_zero, make_comp, seq_tag));
+      seq = hold_check(me_b3(sh(make_comp), seq_zero, make_comp, seq_tag));
-      v  = me_complete_id(v, seq);
+      v = me_complete_id(v, seq);
-      u  = me_complete_id(u, v);
+      u = me_complete_id(u, v);
-      y  = me_complete_id(y, u);
+      y = me_complete_id(y, u);
-      x  = me_complete_id(x, y);
+      x = me_complete_id(x, y);
-      n  = me_complete_id(n, x);
+      n = me_complete_id(n, x);
       sn = me_complete_id(sn, n);
-      z  = me_complete_id(z, sn);
+      z = me_complete_id(z, sn);
       return z;
       }
   }
-  return  real_power(ov_err, arg1, arg2);
+  return real_power(ov_err, arg1, arg2);
 }
-exp f_floating_minus
+exp
-    PROTO_N ( (ov_err, arg1, arg2) )
-    PROTO_T ( error_treatment ov_err X exp arg1 X exp arg2 )
+f_floating_minus(error_treatment ov_err, exp arg1, exp arg2)
+{
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
-    { kill_exp(arg2,arg2); return arg1; }
+    kill_exp(arg2, arg2);
+    return arg1;
+  }
-  if (name(sh(arg2)) == bothd)
+  if (name(sh(arg2)) == bothd) {
-    { kill_exp(arg1,arg1); return arg2; }
+    kill_exp(arg1,arg1);
+    return arg2;
+  }
 #if check_shape
-  if (! ((is_float(sh(arg1)) || is_complex(sh(arg1))) && eq_shape(sh(arg1), sh(arg2))) )
+  if (!((is_float(sh(arg1)) || is_complex(sh(arg1))) &&
+	eq_shape(sh(arg1), sh(arg2)))) {
     failer(CHSH_FLMINUS);
+  }
 #endif
 /* PAB changes - 18 October 1994 */
 #if substitute_complex
   if (is_complex(sh(arg1))) {
-      shape complex_shape = sh(arg1);                     /* shape of our complex numbers */
+      shape complex_shape = sh(arg1);	/* shape of our complex numbers */
       floating_variety real_fv = f_float_of_complex(complex_shape);
       shape real_shape = f_floating(real_fv);
       floating_variety complex_fv = f_complex_of_float(real_shape);
       exp z1 = me_startid(complex_shape, arg1, 0);
       exp z2 = me_startid(complex_shape, arg2, 0);
-      exp x1 = f_real_part     (me_obtain(z1));                      /* re(arg1) */
+      exp x1 = f_real_part(me_obtain(z1));	/* re(arg1) */
-      exp x2 = f_real_part     (me_obtain(z2));                      /* re(arg2) */
+      exp x2 = f_real_part(me_obtain(z2));	/* re(arg2) */
-      exp y1 = f_imaginary_part(me_obtain(z1));                      /* im(arg1) */
+      exp y1 = f_imaginary_part(me_obtain(z1));	/* im(arg1) */
-      exp y2 = f_imaginary_part(me_obtain(z2));                      /* im(arg2) */
+      exp y2 = f_imaginary_part(me_obtain(z2));	/* im(arg2) */
-      exp minus_re  = f_floating_minus(ov_err, x1, x2);
+      exp minus_re = f_floating_minus(ov_err, x1, x2);
-      exp minus_im  = f_floating_minus(ov_err, y1, y2);
+      exp minus_im = f_floating_minus(ov_err, y1, y2);
       exp make_comp = f_make_complex(complex_fv, minus_re, minus_im);
       z2 = me_complete_id(z2, make_comp);
       z1 = me_complete_id(z1, z2);
       return z1;
-  };
+  }
 #endif
 #if ishppa
+  {
     exp r = hold_check(me_b1(ov_err, arg1, arg2, fminus_tag));
-    if (!optop(r) && name(sh(r))==doublehd) {
+    if (!optop(r) && name(sh(r)) == doublehd) {
-      exp id = me_startid(sh(r),r,0);
+      exp id = me_startid(sh(r), r, 0);
-      exp tmp = me_complete_id(id,me_obtain(id));
+      exp tmp = me_complete_id(id, me_obtain(id));
       return tmp;
-     }
-    else
+    } else {
       return r;
+    }
   }
 #endif
-  return  hold_check(me_b1(ov_err, arg1, arg2, fminus_tag));
+  return hold_check(me_b1(ov_err, arg1, arg2, fminus_tag));
 }
-exp f_floating_mult
+exp
-    PROTO_N ( (ov_err, arg1) )
-    PROTO_T ( error_treatment ov_err X exp_list arg1 )
+f_floating_mult(error_treatment ov_err, exp_list arg1)
 {
   exp first = arg1.start;
-  exp r = getexp (sh(first), nilexp, 0, first,
+  exp r = getexp(sh(first), nilexp, 0, first, nilexp, 0, 0, fmult_tag);
-                  nilexp,
-, 0, fmult_tag);
-  if (name(sh(first)) == bothd || arg1.number == 1)
+  if (name(sh(first)) == bothd || arg1.number == 1) {
     return first;
+  }
   clear_exp_list(arg1);
   seterrhandle(r, ov_err.err_code);
-  if (isov(r))
+  if (isov(r)) {
-   setjmp_dest(r, get_lab(ov_err.jmp_dest));
+    setjmp_dest(r, get_lab(ov_err.jmp_dest));
+  }
 #if check_shape
+  {
-  {exp t = first;
+    exp t = first;
-   while (1)
+    while (1) {
-     {
-       if (! ((is_float(sh(t)) || is_complex(sh(t))) && eq_shape(sh(t), sh(first))) )
+      if (!((is_float(sh(t)) || is_complex(sh(t))) &&
+	    eq_shape(sh(t), sh(first)))) {
          failer(CHSH_FLMULT);
+      }
-       if (t == arg1.end)
+      if (t == arg1.end) {
+	break;
-         break;
+      }
-       t = bro(t);
+      t = bro(t);
-       if (name(sh(t)) == bothd)
+      if (name(sh(t)) == bothd) {
-         return t;
+	return t;
-     };
+      }
+    }
-  };
+  }
 #endif
 /* PAB changes - 19 October 1994 */
 #if substitute_complex
   if (is_complex(sh(arg1.start))) {
-      shape complex_shape = sh(arg1.start);            /* shape of our complex numbers */
+      shape complex_shape = sh(arg1.start); /* shape of our complex numbers */
       floating_variety real_fv = f_float_of_complex(complex_shape);
       shape real_shape = f_floating(real_fv);
       floating_variety complex_fv = f_complex_of_float(real_shape);
-      exp  x1, y1, x2, y2, z1, z1_re, z1_im, t, link_next, prod_re, prod_im;
+      exp x1, y1, x2, y2, z1, z1_re, z1_im, t, link_next, prod_re, prod_im;
 #if 0
-      arg1 = reorder_list(arg1, 1);              /* reorder so constants are at the front */
+      arg1 = reorder_list(arg1, 1); /* reorder so constants are at the front */
 #endif
       z1 = me_startid(complex_shape, arg1.start, 0);
-      z1_re = f_real_part     (me_obtain(z1));                 /* re(arg1.first) */
+      z1_re = f_real_part(me_obtain(z1));	/* re(arg1.first) */
-      z1_im = f_imaginary_part(me_obtain(z1));                 /* im(arg1.first) */
+      z1_im = f_imaginary_part(me_obtain(z1));	/* im(arg1.first) */
       x1 = push(z1, me_startid(real_shape, z1_re, 0));
       y1 = push(x1, me_startid(real_shape, z1_im, 0));
       t = arg1.start;
       while (t != arg1.end) {
 	  t = bro(t);
 	  z1 = push(y1, me_startid(complex_shape, t, 0));
-	  z1_re = f_real_part     (me_obtain(z1));    /* contents of next */
+	  z1_re = f_real_part(me_obtain(z1));		/* contents of next */
-	  z1_im = f_imaginary_part(me_obtain(z1));    /* list element     */
+	  z1_im = f_imaginary_part(me_obtain(z1));	/*   list element   */
 	  x2 = push(z1, me_startid(real_shape, z1_re, 0));
 	  y2 = push(x2, me_startid(real_shape, z1_im, 0));
 	  if (eq_exp(x1,x2) && eq_exp(y1,y2)) {
-	      exp minus_x1_x2 = f_floating_minus(ov_err, me_obtain(x1), me_obtain(x2));
+	      exp minus_x1_x2 = f_floating_minus(ov_err, me_obtain(x1),
+						 me_obtain(x2));
-	      exp  plus_x1_x2 = f_bin_floating_plus(ov_err, me_obtain(x1), me_obtain(x2));
+	      exp  plus_x1_x2 = f_bin_floating_plus(ov_err, me_obtain(x1),
+						    me_obtain(x2));
-	      exp  mult_x1_y1 = f_bin_floating_mult(ov_err, me_obtain(x1), me_obtain(y1));
+	      exp  mult_x1_y1 = f_bin_floating_mult(ov_err, me_obtain(x1),
+						    me_obtain(y1));
 	      prod_re = f_bin_floating_mult(ov_err, minus_x1_x2, plus_x1_x2);
-	      prod_im = f_bin_floating_plus(ov_err,  mult_x1_y1, mult_x1_y1);
+	      prod_im = f_bin_floating_plus(ov_err, mult_x1_y1, mult_x1_y1);
-	  }
-	  else
+	  } else {
-	  {
-	      exp mult_x1_x2 = f_bin_floating_mult(ov_err, me_obtain(x1), me_obtain(x2));
+	      exp mult_x1_x2 = f_bin_floating_mult(ov_err, me_obtain(x1),
+						   me_obtain(x2));
-	      exp mult_y1_y2 = f_bin_floating_mult(ov_err, me_obtain(y1), me_obtain(y2));
+	      exp mult_y1_y2 = f_bin_floating_mult(ov_err, me_obtain(y1),
+						   me_obtain(y2));
-	      exp mult_x1_y2 = f_bin_floating_mult(ov_err, me_obtain(x1), me_obtain(y2));
+	      exp mult_x1_y2 = f_bin_floating_mult(ov_err, me_obtain(x1),
+						   me_obtain(y2));
-	      exp mult_x2_y1 = f_bin_floating_mult(ov_err, me_obtain(x2), me_obtain(y1));
+	      exp mult_x2_y1 = f_bin_floating_mult(ov_err, me_obtain(x2),
+						   me_obtain(y1));
 	      prod_re = f_floating_minus(ov_err, mult_x1_x2, mult_y1_y2);
 	      prod_im = f_bin_floating_plus(ov_err, mult_x1_y2, mult_x2_y1);
+	  }
 	  y1 = push(x1, me_startid(real_shape, prod_im, 0));
+      }
       link_next = f_make_complex(complex_fv, me_obtain(x1), me_obtain(y1));
-      return  me_complete_chain(y1, arg1.start, link_next);
+      return me_complete_chain(y1, arg1.start, link_next);
+  }
 #endif
-  setfather (r, arg1.end);
+  setfather(r, arg1.end);
 #if ishppa
-  if (!optop(r) && name(sh(r))==doublehd) {
+  if (!optop(r) && name(sh(r)) == doublehd) {
-    exp id = me_startid(sh(r),r,0);
+    exp id = me_startid(sh(r), r, 0);
-    exp tmp = me_complete_id(id,me_obtain(id));
+    exp tmp = me_complete_id(id, me_obtain(id));
     return tmp;
-   }
-  else
+   } else
 #endif
   return r;
 }
-exp f_floating_negate
+exp
-    PROTO_N ( (ov_err, arg1) )
-    PROTO_T ( error_treatment ov_err X exp arg1 )
+f_floating_negate(error_treatment ov_err, exp arg1)
 {
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
     return arg1;
+  }
 #if check_shape
-  if (!is_float(sh(arg1)) && !is_complex(sh(arg1)))
+  if (!is_float(sh(arg1)) && !is_complex(sh(arg1))) {
     failer(CHSH_FLNEGATE);
+  }
 #endif
 /* PAB changes - 18 October 1994 */
 #if substitute_complex
   if (is_complex(sh(arg1))) {
-      shape complex_shape = sh(arg1);                     /* shape of our complex numbers */
+      shape complex_shape = sh(arg1);	/* shape of our complex numbers */
       floating_variety real_fv = f_float_of_complex(complex_shape);
       shape real_shape = f_floating(real_fv);
       floating_variety complex_fv = f_complex_of_float(real_shape);
       exp c1 = me_startid(complex_shape, arg1, 0);
-      exp obtain1_c1 = hold_check(me_obtain(c1));                     /* contents of arg1 */
+      exp obtain1_c1 = hold_check(me_obtain(c1));	/* contents of arg1 */
       exp obtain2_c1 = hold_check(me_obtain(c1));
-      exp x1 = f_real_part(obtain1_c1);                              /* re(arg1) */
+      exp x1 = f_real_part(obtain1_c1);			/* re(arg1) */
-      exp y1 = f_imaginary_part(obtain2_c1);                         /* im(arg1) */
+      exp y1 = f_imaginary_part(obtain2_c1);		/* im(arg1) */
-      exp neg_re = f_floating_negate(ov_err, x1);                           /* - re(arg1) */
+      exp neg_re = f_floating_negate(ov_err, x1);	/* - re(arg1) */
-      exp neg_im = f_floating_negate(ov_err, y1);                           /* - im(arg1) */
+      exp neg_im = f_floating_negate(ov_err, y1);	/* - im(arg1) */
       exp make_comp = f_make_complex(complex_fv, neg_re, neg_im);
       c1 = me_complete_id(c1, make_comp);
       return c1;
-  };
+  }
 #endif
 #if ishppa
+  {
     exp r = hold_check(me_u1(ov_err, arg1, fneg_tag));
-    if (!optop(r) && name(sh(r))==doublehd) {
+    if (!optop(r) && name(sh(r)) == doublehd) {
-      exp id = me_startid(sh(r),r,0);
+      exp id = me_startid(sh(r), r, 0);
       exp tmp = me_complete_id(id,me_obtain(id));
       return tmp;
-     }
-    else
+    } else {
       return r;
+    }
   }
 #endif
-  return  hold_check(me_u1(ov_err, arg1, fneg_tag));
+  return hold_check(me_u1(ov_err, arg1, fneg_tag));
+}
-exp f_floating_plus
+exp
-    PROTO_N ( (ov_err, arg1) )
-    PROTO_T ( error_treatment ov_err X exp_list arg1 )
+f_floating_plus(error_treatment ov_err, exp_list arg1)
+{
   exp first = arg1.start;
-  exp r = getexp (sh(first), nilexp, 0, first,
+  exp r = getexp(sh(first), nilexp, 0, first, nilexp, 0, 0, fplus_tag);
-                  nilexp, 0, 0, fplus_tag);
-  if (name(sh(first)) == bothd || arg1.number == 1)
+  if (name(sh(first)) == bothd || arg1.number == 1) {
     return first;
+  }
   clear_exp_list(arg1);
   seterrhandle(r, ov_err.err_code);
-  if (isov(r))
+  if (isov(r)) {
     setjmp_dest(r, get_lab(ov_err.jmp_dest));
+  }
 #if check_shape
+  {
-  {exp t = first;
+    exp t = first;
-   while (1)
+    while (1) {
-     {
-       if (! ((is_float(sh(t)) || is_complex(sh(t))) && eq_shape(sh(t), sh(first))) )
+      if (!((is_float(sh(t)) || is_complex(sh(t))) &&
+	    eq_shape(sh(t), sh(first)))) {
          failer(CHSH_FLPLUS);
+      }
-       if (t == arg1.end)
+      if (t == arg1.end) {
          break;
+      }
-       t = bro(t);
+      t = bro(t);
-       if (name(sh(t)) == bothd)
+      if (name(sh(t)) == bothd) {
-         return t;
+	return t;
-     };
+      }
+    }
-  };
+  }
 #endif
 /* PAB changes - 18 October 1994 */
 #if substitute_complex
   if (is_complex(sh(arg1.start))) {
       exp z1, z2, x1, y1, x2, y2, make_comp, t;
-      shape complex_shape = sh(arg1.start);               /* shape of our complex numbers */
+      shape complex_shape = sh(arg1.start); /* shape of our complex numbers */
       floating_variety real_fv = f_float_of_complex(complex_shape);
       shape real_shape = f_floating(real_fv);
       floating_variety complex_fv = f_complex_of_float(real_shape);
 #if 0
-      arg1 = reorder_list(arg1, 1);              /* reorder so constants are at the front */
+      arg1 = reorder_list(arg1, 1); /* reorder so constants are at the front */
 #endif
       z1 = me_startid(complex_shape, arg1.start, 0);
-      x1 = f_real_part     (me_obtain(z1));                    /* re(arg1.first) */
+      x1 = f_real_part(me_obtain(z1));		/* re(arg1.first) */
-      y1 = f_imaginary_part(me_obtain(z1));                    /* im(arg1.first) */
+      y1 = f_imaginary_part(me_obtain(z1));	/* im(arg1.first) */
       t=arg1.start;
-      z2 = z1;                                                   /* start chain of idents */
+      z2 = z1;					/* start chain of idents */
       while (t != arg1.end) {
 	  t = bro(t);
 	  z2 = push(z2, me_startid(complex_shape, t, 0));
-	  x2 = f_real_part     (me_obtain(z2));              /* contents of next */
+	  x2 = f_real_part(me_obtain(z2));	/* contents of next */
-	  y2 = f_imaginary_part(me_obtain(z2));              /*   list element   */
+	  y2 = f_imaginary_part(me_obtain(z2));	/*   list element   */
-	  x1 = f_bin_floating_plus(ov_err, x1, x2);                    /* pass it this on */
+	  x1 = f_bin_floating_plus(ov_err, x1, x2);	/* pass it this on */
-	  y1 = f_bin_floating_plus(ov_err, y1, y2);                    /*  as new result  */
+	  y1 = f_bin_floating_plus(ov_err, y1, y2);	/*  as new result  */
+      }
       make_comp = f_make_complex(complex_fv, x1, y1);
       return me_complete_chain(z2, arg1.start, make_comp);
   }
 #endif
-  setfather (r, arg1.end);
+  setfather(r, arg1.end);
 #if ishppa
-  if (!optop(r) && name(sh(r))==doublehd) {
+  if (!optop(r) && name(sh(r)) == doublehd) {
-    exp id = me_startid(sh(r),r,0);
+    exp id = me_startid(sh(r), r, 0);
-    exp tmp = me_complete_id(id,me_obtain(id));
+    exp tmp = me_complete_id(id, me_obtain(id));
     return tmp;
-   }
-  else
+   } else
 #endif
   return r;
+}
-exp f_floating_test
+exp
-    PROTO_N ( (prob, flpt_err, nt, dest, arg1, arg2) )
+f_floating_test(nat_option prob, error_treatment flpt_err, ntest nt,
-    PROTO_T ( nat_option prob X error_treatment flpt_err X ntest nt X label dest X exp arg1 X exp arg2 )
+		label dest, exp arg1, exp arg2)
+{
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
-    { kill_exp(arg2,arg2); return arg1; }
+    kill_exp(arg2, arg2);
+    return arg1;
+  }
-  if (name(sh(arg2)) == bothd)
+  if (name(sh(arg2)) == bothd) {
-    { kill_exp(arg1,arg1); return arg2; }
+    kill_exp(arg1,arg1);
+    return arg2;
+  }
 #if check_shape
-  if (! ((is_float(sh(arg1)) || is_complex(sh(arg1))) && eq_shape(sh(arg1), sh(arg2))) )
+  if (!((is_float(sh(arg1)) || is_complex(sh(arg1))) &&
+	eq_shape(sh(arg1), sh(arg2)))) {
     failer(CHSH_FLTEST);
+  }
 #endif
 /* PAB changes - 18 October 1994 */
 #if substitute_complex
-  if (is_complex(sh(arg1))) {                               /* is arg1 a complex number ? */
+  if (is_complex(sh(arg1))) {		/* is arg1 a complex number ? */
-      shape complex_shape = sh(arg1);                     /* shape of our complex numbers */
+      shape complex_shape = sh(arg1);	/* shape of our complex numbers */
       exp z1 = me_startid(complex_shape, arg1, 0);
       exp z2 = me_startid(complex_shape, arg2, 0);
-      exp obtain1_z1 = hold_check(me_obtain(z1));                     /* contents of arg1 */
+      exp obtain1_z1 = hold_check(me_obtain(z1));	/* contents of arg1 */
       exp obtain2_z1 = hold_check(me_obtain(z1));
-      exp obtain1_z2 = hold_check(me_obtain(z2));                     /* contents of arg2 */
+      exp obtain1_z2 = hold_check(me_obtain(z2));	/* contents of arg2 */
       exp obtain2_z2 = hold_check(me_obtain(z2));
-      exp x1 = f_real_part     (obtain1_z1);                         /* re(arg1) */
+      exp x1 = f_real_part(obtain1_z1);			/* re(arg1) */
-      exp x2 = f_real_part     (obtain1_z2);                         /* re(arg2) */
+      exp x2 = f_real_part(obtain1_z2);			/* re(arg2) */
-      exp y1 = f_imaginary_part(obtain2_z1);                         /* im(arg1) */
+      exp y1 = f_imaginary_part(obtain2_z1);		/* im(arg1) */
-      exp y2 = f_imaginary_part(obtain2_z2);                         /* im(arg2) */
+      exp y2 = f_imaginary_part(obtain2_z2);		/* im(arg2) */
 #if check_shape
       if ((nt != f_equal) && (nt != f_not_equal))
 	  failer(CHSH_FLTEST);
 #endif
+      if (nt == f_equal) {
-      if (nt == f_equal) {                                       /* equality of z1 and z2 */
+	  /* equality of z1 and z2 */
-	  exp test1 = f_floating_test (prob, flpt_err, f_equal, dest, x1, x2);
+	  exp test1 = f_floating_test(prob, flpt_err, f_equal, dest, x1, x2);
-	  exp test2 = f_floating_test (prob, flpt_err, f_equal, dest, y1, y2);
+	  exp test2 = f_floating_test(prob, flpt_err, f_equal, dest, y1, y2);
 	  exp seq_zero = hold_check(me_u2(test1, 0));
-	  exp seq      = hold_check(me_b3(sh(test2), seq_zero, test2, seq_tag));
+	  exp seq = hold_check(me_b3(sh(test2), seq_zero, test2, seq_tag));
-	  z2           = me_complete_id(z2, seq);
+	  z2 = me_complete_id(z2, seq);
+      } else {
-      } else {                                                 /* inequality of z1 and z2 */
+	  /* inequality of z1 and z2 */
 	  exp seq, conditional;
 	  exp top_cell = me_l1(f_top, top_tag);
-	  exp alt_labst = hold_check(me_b3(f_top, me_null(f_top,0,clear_tag),
+	  exp alt_labst = hold_check(me_b3(f_top, me_null(f_top, 0, clear_tag),
-                                                          top_cell, labst_tag));
-	  exp test1 = f_floating_test (prob, flpt_err, f_equal,
-				       make_label(alt_labst), x1, x2);
-	  exp test2 = f_floating_test (prob, flpt_err, f_not_equal,
-				       dest, y1, y2);
+					   top_cell, labst_tag));
-      	  exp seq_zero = hold_check(me_b2(test1, test2, 0));
+	  exp test1 = f_floating_test(prob, flpt_err, f_equal,
+				      make_label(alt_labst), x1, x2);
-	  seq = hold_check(me_b3(f_bottom, seq_zero, f_make_top(), seq_tag));
+	  exp test2 = f_floating_test(prob, flpt_err, f_not_equal, dest, y1,
+				      y2);
+      	  exp seq_zero = hold_check(me_b2(test1, test2, 0));
-	  conditional = hold_check(me_b3(f_top,
+	  seq = hold_check(me_b3(f_bottom, seq_zero, f_make_top(), seq_tag));
-					 seq, alt_labst, cond_tag));
+	  conditional = hold_check(me_b3(f_top, seq, alt_labst, cond_tag));
 	  z2 = me_complete_id(z2, conditional);
+      }
       z1 = me_complete_id(z1, z2);
       return z1;
   }
 #endif
   return me_q2(prob, flpt_err, nt, dest, arg1, arg2, test_tag);
+}
-exp f_imaginary_part
+exp
-    PROTO_N ( (arg1) )
-    PROTO_T ( exp arg1 )
+f_imaginary_part(exp arg1)
+{
   shape real_shape;
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
     return arg1;
+  }
 #if check_shape
-  if (!is_complex(sh(arg1)))
+  if (!is_complex(sh(arg1))) {
     failer(CHSH_IMAG);
+  }
 #endif
 /* PAB changes - 25 May 1995 */
   real_shape = f_floating(f_float_of_complex(sh(arg1)));
 #if substitute_complex
+  {
     exp t = me_u3(real_shape, arg1, field_tag);
     no(t) = shape_size(real_shape);
     return hold_check(t);
   }
 #else
   return me_u3(real_shape, arg1, imag_tag);
 #endif
+}
-exp f_real_part
+exp
-    PROTO_N ( (arg1) )
-    PROTO_T ( exp arg1 )
+f_real_part(exp arg1)
+{
   shape real_shape;
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
     return arg1;
+  }
 #if check_shape
-  if (!is_complex(sh(arg1)))
+  if (!is_complex(sh(arg1))) {
     failer(CHSH_REAL);
+  }
 #endif
 /* PAB changes - 25 May 1995 */
   real_shape = f_floating(f_float_of_complex(sh(arg1)));
 #if substitute_complex
   return me_u3(real_shape, arg1, realpart_tag);
 #endif
+}
-exp f_make_complex
+exp
-    PROTO_N ( (f, arg1, arg2) )
-    PROTO_T ( floating_variety f X exp arg1 X exp arg2 )
+f_make_complex(floating_variety f, exp arg1, exp arg2)
+{
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
-    { kill_exp(arg2,arg2); return arg1; }
+    kill_exp(arg2, arg2);
+    return arg1;
+  }
-  if (name(sh(arg2)) == bothd)
+  if (name(sh(arg2)) == bothd) {
-    { kill_exp(arg1,arg1); return arg2; }
+    kill_exp(arg1, arg1);
+    return arg2;
+  }
 #if check_shape
   if (!is_float(sh(arg1)) || !is_float(sh(arg2)) ||
-	!eq_shape(sh(arg1), sh(arg2)) || f != f_complex_of_float(sh(arg1)))
+      !eq_shape(sh(arg1), sh(arg2)) || f != f_complex_of_float(sh(arg1))) {
     failer(CHSH_MAKE_COMPLEX);
+  }
 #endif
 /* PAB changes - 19 October 1994 */
 #if substitute_complex
   switch (f) {
+        {
 	 shape off_set = f_offset(SHREAL_ALIGN, SHREAL_ALIGN);
 	 exp val1 = me_shint(off_set, 0);
 	 exp val2 = me_shint(off_set, SHREAL_SZ);
 	 exp sz = me_shint(off_set, SHREAL_SZ + SHREAL_SZ);
-	 exp r = getexp(f_compound(sz), nilexp, 0, val1, nilexp, 0, 0, compound_tag);
+	 exp r = getexp(f_compound(sz), nilexp, 0, val1, nilexp, 0, 0,
+			compound_tag);
 	 setbro(val1, arg1);
 	 clearlast(val1);
 	 setbro(arg1, val2);
 	 clearlast(arg1);
+       {
 	 shape off_set = f_offset(REAL_ALIGN, REAL_ALIGN);
 	 exp val1 = me_shint(off_set, 0);
 	 exp val2 = me_shint(off_set, REAL_SZ);
 	 exp sz = me_shint(off_set, REAL_SZ + REAL_SZ);
-	 exp r = getexp(f_compound(sz), nilexp, 0, val1, nilexp, 0, 0, compound_tag);
+	 exp r = getexp(f_compound(sz), nilexp, 0, val1, nilexp, 0, 0,
+			compound_tag);
 	 setbro(val1, arg1);
 	 clearlast(val1);
 	 setbro(arg1, val2);
 	 clearlast(arg1);
+       {
 	 shape off_set = f_offset(DOUBLE_ALIGN, DOUBLE_ALIGN);
 	 exp val1 = me_shint(off_set, 0);
 	 exp val2 = me_shint(off_set, DOUBLE_SZ);
 	 exp sz = me_shint(off_set, DOUBLE_SZ + DOUBLE_SZ);
-	 exp r = getexp(f_compound(sz), nilexp, 0, val1, nilexp, 0, 0, compound_tag);
+	 exp r = getexp(f_compound(sz), nilexp, 0, val1, nilexp, 0, 0,
+			compound_tag);
 	 setbro(val1, arg1);
 	 clearlast(val1);
 	 setbro(arg1, val2);
 	 clearlast(arg1);
+       {
 	 failer("Illegal floating_variety for make_complex_tag\n");
+       }
+  }
 #endif
-  return me_b3(f_floating(f), arg1, arg2,
+  return me_b3(f_floating(f), arg1, arg2, make_complex_tag);
-		 make_complex_tag);
+}
 #if FBASE == 10
-exp f_make_floating
+exp
-    PROTO_N ( (fv, rm, sign, mantissa, base, expo) )
+f_make_floating(floating_variety fv, rounding_mode rm, bool sign,
-    PROTO_T ( floating_variety fv X rounding_mode rm X bool sign X string mantissa X nat base X signed_nat expo )
+		string mantissa, nat base, signed_nat expo)
 {
   int ignore_zero = 1;
   int lg = mantissa.number;
-  flpt f = new_flpt ();
+  flpt f = new_flpt();
-  int  sig_digs = 0;
+  int sig_digs = 0;
-  int  i;
+  int i;
   int point = 0;
   char ch;
   int exponent = snatint(expo);
-  if (PIC_code)
+  if (PIC_code) {
     proc_externs = 1;
+  }
-  if (snatneg(expo))
+  if (snatneg(expo)) {
     exponent = - exponent;
+  }
-  if (natint(base) != 10)
+  if (natint(base) != 10) {
-    failer (BASE_NOT_10);
+    failer(BASE_NOT_10);
+  }
-  for (i = 0; i < MANT_SIZE; ++i)
+  for (i = 0; i < MANT_SIZE; ++i) {
     (flptnos[f].mant)[i] = 0;
+  }
   for (i = 0; i < lg; ++i) {
     ch = mantissa.ints.chars[i];
     if (ch == '0' && ignore_zero) {
-      if (point)
+      if (point) {
 	--exponent;
-    }
+      }
-    else {
+    } else {
-      if (ch == '.')
+      if (ch == '.') {
 	point = 1;
-      else {
+      } else {
 	ignore_zero = 0;
-	if (!point)
+	if (!point) {
 	  ++exponent;
+	}
-	if (sig_digs < MANT_SIZE)
+	if (sig_digs < MANT_SIZE) {
-	  (flptnos[f].mant)[sig_digs++] = ch - '0';
+	 (flptnos[f].mant)[sig_digs++] = ch - '0';
+	}
-      };
+      }
-    };
+    }
-  };
+  }
   if (ignore_zero) {
     flptnos[f].exp = 0;
     flptnos[f].sign = 0;
-  }
-  else {
+  } else {
     flptnos[f].exp = exponent - 1;
     flptnos[f].sign = (sign ? -1 : 1);
-  };
+  }
-  if (flptnos[f].exp > target_dbl_maxexp)
+  if (flptnos[f].exp > target_dbl_maxexp) {
-    failer (BIG_FLPT);
+    failer(BIG_FLPT);
+  }
-  return (getexp (f_floating(fv), nilexp, 0, nilexp, nilexp,
+  return(getexp(f_floating(fv), nilexp, 0, nilexp, nilexp, 0, f, real_tag));
-, f, real_tag));
+}
 #else
-exp f_make_floating
+exp
-    PROTO_N ( (fv, rm, sign, mantissa, natbase, expo) )
+f_make_floating(floating_variety fv, rounding_mode rm, bool sign,
-    PROTO_T ( floating_variety fv X rounding_mode rm X bool sign X string mantissa X nat natbase X signed_nat expo )
+		string mantissa, nat natbase, signed_nat expo)
+{
   int ignore_zero = 1;
   int lg = mantissa.number;
-  flpt f = new_flpt ();
+  flpt f = new_flpt();
-  int  has_sig_digs = 0;
+  int has_sig_digs = 0;
-  int  i;
+  int i;
   int point = 0;
   int exponent = snatint(expo);
   flt fr;
   int base = natint(natbase);
   flt_zero(&fr);
-  if (PIC_code)
+  if (PIC_code) {
     proc_externs = 1;
+  }
-  if (base != 10 && base != 16 && base !=8 && base != 2 && base != 4)
+  if (base != 10 && base != 16 && base !=8 && base != 2 && base != 4) {
-    failer (BAD_BASE);
+    failer(BAD_BASE);
+  }
-  if (snatneg(expo))
+  if (snatneg(expo)) {
-    exponent = - exponent;
+    exponent =- exponent;
+  }
   for (i = 0; i < lg; ++i) {
     char c = mantissa.ints.chars[i];
     if (c != '0' || !ignore_zero) {
       ignore_zero = 0;
-      if (c == '.')
+      if (c == '.') {
 	point = 1;
-      else {
+      } else {
 	c = c - '0';
-	if (c != 0)
+	if (c != 0) {
 	  has_sig_digs = 1;
+	}
         exponent -= point;
 	flpt_newdig((unsigned int)c, &fr, base);
-      };
+      }
-    };
+    }
-  };
+  }
   if (ignore_zero) {
     fr.exp = 0;
     fr.sign = 0;
-  }
-  else {
+  } else {
-    if (has_sig_digs)
+    if (has_sig_digs) {
       fr.sign = (sign ? -1 : 1);
-    else
+    } else {
       fr.sign = 0;
+    }
     flpt_scale(exponent, &fr, base);
-  };
+  }
   flpt_round((int)rm, flpt_bits((floating_variety)fv), &fr);
   if (flpt_const_overflow_fail) {
     r2l r;
     r = real2longs_IEEE(&fr, fv);
     UNUSED(r);
-  };
+  }
   flptnos[f] = fr;
-  return (getexp (f_floating(fv), nilexp, 0, nilexp, nilexp,
+  return(getexp(f_floating(fv), nilexp, 0, nilexp, nilexp, 0, f, real_tag));
-, f, real_tag));
+}
 #endif
-exp f_power
+exp
-    PROTO_N ( (ov_err, arg1, arg2) )
-    PROTO_T ( error_treatment ov_err X exp arg1 X exp arg2 )
+f_power(error_treatment ov_err, exp arg1, exp arg2)
+{
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
-    { kill_exp(arg2,arg2); return arg1; }
+    kill_exp(arg2,arg2);
+    return arg1;
+  }
-  if (name(sh(arg2)) == bothd)
+  if (name(sh(arg2)) == bothd) {
-    { kill_exp(arg1,arg1); return arg2; }
+    kill_exp(arg1,arg1);
+    return arg2;
+  }
 #if check_shape
-  if (!is_integer(sh(arg1)) || !is_integer(sh(arg2)))
+  if (!is_integer(sh(arg1)) || !is_integer(sh(arg2))) {
     failer(CHSH_POWER);
+  }
 #endif
-  return  real_power(ov_err, arg1, arg2);
+  return real_power(ov_err, arg1, arg2);
 }
-exp f_round_with_mode
+exp
-    PROTO_N ( (flpt_err, mode, r, arg1) )
-    PROTO_T ( error_treatment flpt_err X rounding_mode mode X variety r X exp arg1 )
+f_round_with_mode(error_treatment flpt_err, rounding_mode mode, variety r,
+		  exp arg1)
+{
   exp res;
-  if (name(sh(arg1)) == bothd)
+  if (name(sh(arg1)) == bothd) {
     return arg1;
+  }
   if (is_complex(sh(arg1))) {
 	arg1 = f_real_part(arg1);
   }
 #if check_shape
-  if (!is_float(sh(arg1)))
+  if (!is_float(sh(arg1))) {
     failer(CHSH_ROUND);
+  }
 #endif
 #if !has64bits
+	if (shape_size(r) >32 &&
-	if ( shape_size(r)>32 && (name(arg1) != real_tag || flpt_err.err_code>=4)   ) {
+	    (name(arg1) != real_tag || flpt_err.err_code >= 4)) {
 		int s = is_signed(r);
-		char * fn;
+		char *fn;
 		exp e;
 #if use_long_double
-	        arg1 = hold_check(
+	        arg1 = hold_check(f_change_floating_variety(f_impossible, 2,
-		  f_change_floating_variety(f_impossible, 2, arg1));
+							    arg1));
 #else
-	        arg1 = hold_check(
+	        arg1 = hold_check(f_change_floating_variety(f_impossible, 1,
-		  f_change_floating_variety(f_impossible, 1, arg1));
+							    arg1));
 #endif
-		switch(mode) {
+		switch (mode) {
+		case R2NEAR:
-		case R2NEAR: fn = (s)?"__TDFUs_R2NEAR":"__TDFUu_R2NEAR"; break;
+			fn = (s) ? "__TDFUs_R2NEAR" : "__TDFUu_R2NEAR";
+			break;
+		case R2PINF:
-		case R2PINF: fn = (s)?"__TDFUs_R2PINF":"__TDFUu_R2PINF"; break;
+			fn = (s) ? "__TDFUs_R2PINF" : "__TDFUu_R2PINF";
+			break;
+		case R2NINF:
-		case R2NINF: fn = (s)?"__TDFUs_R2NINF":"__TDFUu_R2NINF"; break;
+			fn = (s) ? "__TDFUs_R2NINF" : "__TDFUu_R2NINF";
+			break;
+		case R2ZERO:
-		case R2ZERO: fn = (s)?"__TDFUs_R2ZERO":"__TDFUu_R2ZERO"; break;
+			fn = (s) ? "__TDFUs_R2ZERO" : "__TDFUu_R2ZERO";
+			break;
+		default:
-		default: fn = (s)?"__TDFUs_ASSTATE":"__TDFUu_R2ASSTATE";
+			fn = (s) ? "__TDFUs_ASSTATE" : "__TDFUu_R2ASSTATE";
+		}
 		e = TDFcallaux(flpt_err, arg1, fn, r);
-		return (hold_check(e));
+		return(hold_check(e));
+	}
 #endif
 #if ismips
 	/* mips does not seem to get float->unsigned long right -
-		so convert to signed long and adjust if too big*/
+	   so convert to signed long and adjust if too big*/
-	else
-	if (name(arg1)!=real_tag && shape_size(r)==32 && !is_signed(r) ) {
+	else if (name(arg1) != real_tag && shape_size(r) == 32 &&
+		 !is_signed(r)) {
-		floating_variety fa = (shape_size(sh(arg1))==32)?0:1;
+		floating_variety fa = (shape_size(sh(arg1)) == 32) ? 0 : 1;
 		exp_list st;
 		exp z;
 		exp d1 = me_startid(r, arg1, 0);
 		exp hldr = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, 0);
-		exp lb = getexp(f_top, nilexp, 0, hldr, nilexp, 0, 0, labst_tag);
+		exp lb = getexp(f_top, nilexp, 0, hldr, nilexp, 0, 0,
+				labst_tag);
 		exp fmax = hold_check(f_float_int(f_impossible, fa,
-					me_shint(ulongsh,0x80000000 )));
+						  me_shint(ulongsh,
+x80000000)));
 		exp d2 = me_startid(r, fmax, 0);
-		exp tst =  f_floating_test(no_nat_option,
+		exp tst = f_floating_test(no_nat_option, f_impossible,
-				f_impossible, f_less_than, &lb,
+					  f_less_than, &lb, me_obtain(d1),
-				me_obtain(d1), me_obtain(d2));
+					  me_obtain(d2));
 		exp nconv = f_round_with_mode(flpt_err, mode, slongsh,
-					me_obtain(d1));
+					      me_obtain(d1));
-		exp first; exp alt; exp cnd;
+		exp first;
+		exp alt;
+		exp cnd;
 		st = new_exp_list(1);
 		st = add_exp_list(st, tst, 0);
 		first = f_sequence(st, f_change_variety(flpt_err, r, nconv));
 		z = f_round_with_mode(flpt_err, mode, slongsh,
-			f_floating_minus(f_impossible, me_obtain(d1), me_obtain(d2)));
+				      f_floating_minus(f_impossible,
+						       me_obtain(d1),
+						       me_obtain(d2)));
-		alt = f_plus(f_impossible,
+		alt = f_plus(f_impossible, f_change_variety(f_impossible, r, z),
-		   f_change_variety(f_impossible, r, z), me_shint(r, 0x80000000));
+			     me_shint(r, 0x80000000));
 		cnd = f_conditional(&lb, first, alt);
 		return me_complete_id(d1, me_complete_id(d2, cnd));
+	}
 #endif
 #if ispower
- if (name(arg1)!=real_tag || flpt_err.err_code>2) {
+ if (name(arg1) != real_tag || flpt_err.err_code > 2) {
-  if (architecture!=POWERPC_CODE)
+   if (architecture != POWERPC_CODE) {
-  {
-    exp id;
+     exp id;
-    exp apply1;
+     exp apply1;
-    exp apply2;
+     exp apply2;
-    long shp_sze = shape_size(f_integer(r));
+     long shp_sze = shape_size(f_integer(r));
-    bool sgned = is_signed(f_integer(r));
+     bool sgned = is_signed(f_integer(r));
-    bool err = (flpt_err.err_code>2);
+     bool err = (flpt_err.err_code > 2);
-    char *nm ;
+     char *nm;
-    char *nm_err;
+     char *nm_err;
-    int power_mode;
+     int power_mode;
-    /* Set up ident to hold arg1 */
+     /* Set up ident to hold arg1 */
-    if (name(sh(arg1))==shrealhd)
+     if (name(sh(arg1)) == shrealhd) {
-    {
-      arg1 = f_change_floating_variety(f_impossible,realfv,arg1);
+       arg1 = f_change_floating_variety(f_impossible, realfv, arg1);
-    }
+     }
-    id = me_startid(f_top,arg1,0);
+     id = me_startid(f_top, arg1, 0);
-  /* Set up power_mode */
+     /* Set up power_mode */
-    switch (mode)
+     switch (mode) {
-    {
+       case R2ZERO:
-      case R2ZERO: power_mode = 0;break;
+ 	      power_mode = 0;
+ 	      break;
+       case R2NEAR:
-      case R2NEAR: power_mode = 1;break;
+ 	      power_mode = 1;
+ 	      break;
+       case R2PINF:
-      case R2PINF: power_mode = 2;break;
+ 	      power_mode = 2;
+ 	      break;
+       case R2NINF:
-      case R2NINF: power_mode = 3;break;
+ 	      power_mode = 3;
+ 	      break;
+       default:
-      default:power_mode = 1;break;
+ 	      power_mode = 1;
+ 	      break;
-    }
+     }
-    /* Work out which functions to call */
+     /* Work out which functions to call */
-    if (sgned)
+     if (sgned) {
-    {
-      nm = "__TDFrnd_sgned";
+       nm = "__TDFrnd_sgned";
-      nm_err = "__TDFerr_rnd_sgned";
+       nm_err = "__TDFerr_rnd_sgned";
-    }
-    else
+     } else {
-    {
-      nm = "__TDFrnd_unsgned";
+       nm = "__TDFrnd_unsgned";
-      nm_err = "__TDFerr_rnd_unsgned";
+       nm_err = "__TDFerr_rnd_unsgned";
-    }
+     }
-    {
+     {
-      exp_list pars2;
+       exp_list pars2;
-      exp_option no_var ;
+       exp_option no_var;
-      pars2 = new_exp_list(2);
+       pars2 = new_exp_list(2);
-      no_var.present = 0;
+       no_var.present = 0;
-      pars2 = add_exp_list(pars2,me_obtain(id),0);
+       pars2 = add_exp_list(pars2, me_obtain(id), 0);
-      pars2 = add_exp_list(pars2,me_shint(uwordsh,power_mode),1);
+       pars2 = add_exp_list(pars2, me_shint(uwordsh, power_mode), 1);
-      apply2 = f_apply_proc(sgned?slongsh:ulongsh,me_obtain(find_named_tg(nm,f_proc)),pars2,no_var);
+       apply2 = f_apply_proc(sgned ? slongsh : ulongsh,
+ 			    me_obtain(find_named_tg(nm, f_proc)), pars2,
+ 			    no_var);
-    }
+     }
-    if (err)
+     if (err) {
-    {
-      exp_list st;
+       exp_list st;
-      exp seq;
+       exp seq;
-      exp pl;
+       exp pl;
-      exp_list pars1;
+       exp_list pars1;
-      exp_option no_var;
+       exp_option no_var;
-      no_var.present = 0;
+       no_var.present = 0;
-      pars1 = new_exp_list(2);
+       pars1 = new_exp_list(2);
-      pars1 = add_exp_list(pars1,me_obtain(id),0);
+       pars1 = add_exp_list(pars1, me_obtain(id), 0);
-      pars1 = add_exp_list(pars1,me_shint(uwordsh,power_mode),1);
+       pars1 = add_exp_list(pars1, me_shint(uwordsh, power_mode), 1);
-      apply1 = f_apply_proc(f_top,me_obtain(find_named_tg(nm_err,f_proc)),pars1,no_var);
+       apply1 = f_apply_proc(f_top, me_obtain(find_named_tg(nm_err, f_proc)),
+ 			    pars1, no_var);
+       pl = f_plus(flpt_err, me_shint(slongsh, INT_MAX),
-      pl = f_plus(flpt_err,me_shint(slongsh,INT_MAX),me_obtain(find_named_tg("__TDFrnd_error",slongsh)));
+ 		  me_obtain(find_named_tg("__TDFrnd_error", slongsh)));
-      st = new_exp_list(2);
+       st = new_exp_list(2);
-      st = add_exp_list(st,apply1,0);
+       st = add_exp_list(st, apply1, 0);
-      st = add_exp_list(st,pl,1);
+       st = add_exp_list(st, pl, 1);
-      seq = f_sequence(st,apply2);
+       seq = f_sequence(st, apply2);
-      id = me_complete_id(id,seq);
+       id = me_complete_id(id, seq);
-    }
-    else
+     } else {
-    {
-      id = me_complete_id(id,apply2);
+       id = me_complete_id(id, apply2);
-    }
+     }
-    if (shp_sze <32)
+     if (shp_sze < 32) {
-    {
-      id = f_change_variety(flpt_err,f_integer(r),id);
+       id = f_change_variety(flpt_err, f_integer(r), id);
-    }
+     }
-    return id;
+     return id;
-  }/*end ispower */
+   }/*end ispower */
+ }
   /* FALL THROUGH */
 #endif
-  res = getexp (f_integer(r), nilexp, 0, arg1, nilexp,
+  res = getexp(f_integer(r), nilexp, 0, arg1, nilexp, 0, 0, round_tag);
-, 0, round_tag);
   setround_number(res, mode);
   seterrhandle(res, flpt_err.err_code);
-  if (flpt_err.err_code ==  4)
+  if (flpt_err.err_code == 4) {
     setjmp_dest(res, get_lab(flpt_err.jmp_dest));
+  }
-  setfather (res, arg1);
+  setfather(res, arg1);
   return res;
+}
-floating_variety f_flvar_parms
+floating_variety
-    PROTO_N ( (base, mantissa_digits, minimum_exponent, maximum_exponent) )
+f_flvar_parms(nat base, nat mantissa_digits, nat minimum_exponent,
-    PROTO_T ( nat base X nat mantissa_digits X nat minimum_exponent X nat maximum_exponent )
+	      nat maximum_exponent)
+{
   int b = natint(base);
   int mantdig = natint(mantissa_digits);
   int neg_minexp = natint(minimum_exponent);
   int maxexp = natint(maximum_exponent);
 		failer("base in flvar_parms must be a power of 2");
+	}
 	mantdig+=mantdig;
 	neg_minexp+=neg_minexp;
 	maxexp+=maxexp;
-	b = (b>>1);
+	b = (b >> 1);
+  }
-	if (mantdig <= 24 && neg_minexp <= 126 &&
+	if (mantdig <= 24 && neg_minexp <= 126 && maxexp <= 127) {
-                 maxexp <= 127)
-	  return (0);
+	  return(0);
+	}
-	if (mantdig <= 53 && neg_minexp <= 1022 &&
+	if (mantdig <= 53 && neg_minexp <= 1022 && maxexp <= 1023) {
-                 maxexp <= 1023)
-	  return (1);
+	  return(1);
+	}
 #if use_long_double
-	if (mantdig <= 64 && neg_minexp <= 16382 &&
+	if (mantdig <= 64 && neg_minexp <= 16382 && maxexp <= 16383) {
-                 maxexp <= 16383)
-	  return (2);
+	  return(2);
+	}
-	return (2);
+	return(2);
 #else
         return 1;
 #endif
-}
-floating_variety f_complex_parms
-    PROTO_N ( (base, mantissa_digits, minimum_exponent, maximum_exponent) )
-    PROTO_T ( nat base X nat mantissa_digits X nat minimum_exponent X nat maximum_exponent )
-{
-  return float_to_complex_var(f_flvar_parms(base, mantissa_digits,
-			 minimum_exponent, maximum_exponent));
+}
-void init_floating_variety
+floating_variety
+f_complex_parms(nat base, nat mantissa_digits, nat minimum_exponent,
+		nat maximum_exponent)
+{
+  return float_to_complex_var(f_flvar_parms(base, mantissa_digits,
-    PROTO_Z ()
+					    minimum_exponent,
+					    maximum_exponent));
+}
+void
+init_floating_variety(void)
+{
-  shrealsh = getshape(0, const_al1, const_al1, SHREAL_ALIGN,
+  shrealsh = getshape(0, const_al1, const_al1, SHREAL_ALIGN, SHREAL_SZ,
-			 SHREAL_SZ, shrealhd);
+		      shrealhd);
   realsh = getshape(0, const_al1, const_al1, REAL_ALIGN, REAL_SZ, realhd);
-  doublesh = getshape(0, const_al1, const_al1, DOUBLE_ALIGN,
+  doublesh = getshape(0, const_al1, const_al1, DOUBLE_ALIGN, DOUBLE_SZ,
-			 DOUBLE_SZ, doublehd);
+		      doublehd);
 #if substitute_complex
-  shcomplexsh = getshape(0, const_al1, const_al1, SHREAL_ALIGN,
+  shcomplexsh = getshape(0, const_al1, const_al1, SHREAL_ALIGN, 2 * SHREAL_SZ,
-*SHREAL_SZ, cpdhd);
+			 cpdhd);
-  complexsh = getshape(0, const_al1, const_al1, REAL_ALIGN,
+  complexsh = getshape(0, const_al1, const_al1, REAL_ALIGN, 2 * REAL_SZ, cpdhd);
-*REAL_SZ, cpdhd);
   complexdoublesh = getshape(0, const_al1, const_al1, DOUBLE_ALIGN,
-*DOUBLE_SZ, cpdhd);
+* DOUBLE_SZ, cpdhd);
 #else
-  shcomplexsh = getshape(0, const_al1, const_al1, SHREAL_ALIGN,
+  shcomplexsh = getshape(0, const_al1, const_al1, SHREAL_ALIGN, 2 * SHREAL_SZ,
-*SHREAL_SZ, shcomplexhd);
+			 shcomplexhd);
-  complexsh = getshape(0, const_al1, const_al1, REAL_ALIGN,
+  complexsh = getshape(0, const_al1, const_al1, REAL_ALIGN, 2 * REAL_SZ,
-*REAL_SZ, complexhd);
+		       complexhd);
   complexdoublesh = getshape(0, const_al1, const_al1, DOUBLE_ALIGN,
-*DOUBLE_SZ, complexdoublehd);
+* DOUBLE_SZ, complexdoublehd);
 #endif
   return;
 }
 floating_variety f_dummy_floating_variety;
-floating_variety f_float_of_complex
+floating_variety
-    PROTO_N ( (sha) )
-    PROTO_T ( shape sha )
+f_float_of_complex(shape sha)
+{
-	int s = shape_size(sha)/2;
+	int s = shape_size(sha) / 2;
+	if (s == SHREAL_SZ) {
-	if (s==SHREAL_SZ) return shrealfv;
+	  return shrealfv;
+	}
+	if (s == REAL_SZ) {
-	if (s==REAL_SZ) return realfv;
+	  return realfv;
+	}
+	if (s == DOUBLE_SZ) {
-	if (s==DOUBLE_SZ) return doublefv;
+	  return doublefv;
+	}
 	failer("Expecting a complex shape");
 	return f_dummy_floating_variety;
 }
-floating_variety f_complex_of_float
+floating_variety
-    PROTO_N ( (sha) )
-    PROTO_T ( shape sha )
+f_complex_of_float(shape sha)
+{
 	int s = shape_size(sha);
+	if (s == SHREAL_SZ) {
-	if (s==SHREAL_SZ) return shcomplexfv;
+	  return shcomplexfv;
+	}
+	if (s == REAL_SZ) {
-	if (s==REAL_SZ) return complexfv;
+	  return complexfv;
+	}
+	if (s == DOUBLE_SZ) {
-	if (s==DOUBLE_SZ) return complexdoublefv;
+	  return complexdoublefv;
+	}
 	failer("Expecting a floating shape");
 	return f_dummy_floating_variety;
+}
-floating_variety fv_of_shape
+floating_variety
-    PROTO_N ( (sha) )
-    PROTO_T ( shape sha )
+fv_of_shape(shape sha)
+{
 	int s = shape_size(sha);
+	if (s == SHREAL_SZ) {
-	if (s==SHREAL_SZ) return shrealfv;
+	  return shrealfv;
+	}
+	if (s == REAL_SZ) {
-	if (s==REAL_SZ) return realfv;
+	  return realfv;
+	}
+	if (s == DOUBLE_SZ) {
-	if (s==DOUBLE_SZ) return doublefv;
+	  return doublefv;
+	}
 	failer("Expecting a complex shape");
 	return f_dummy_floating_variety;
+}
-static void square_x_iy
+static
-    PROTO_N ( (ov_err, arg1, arg2, arg3) )
-    PROTO_T ( error_treatment ov_err X exp *arg1 X exp *arg2 X exp arg3 )
+void square_x_iy(error_treatment ov_err, exp *arg1, exp *arg2, exp arg3)
+{
     exp x = *arg1;
     exp y = *arg2;
     exp obtain1_x = me_obtain(x);
     exp obtain1_y = me_obtain(y);
     exp obtain2_y = me_obtain(y);
     exp obtain3_y = me_obtain(y);
     exp minus_x_y = f_floating_minus(ov_err, obtain1_x, obtain1_y);
-    exp  plus_x_y = f_bin_floating_plus(ov_err, obtain2_x, obtain2_y);
+    exp plus_x_y = f_bin_floating_plus(ov_err, obtain2_x, obtain2_y);
-    exp  mult_x_y = f_bin_floating_mult(ov_err, obtain3_x, obtain3_y);
+    exp mult_x_y = f_bin_floating_mult(ov_err, obtain3_x, obtain3_y);
     exp tmp = push(arg3, me_startid(sh(x), mult_x_y, 0));
     exp obtain1_tmp = hold_check(me_obtain(tmp));
     exp obtain2_tmp = hold_check(me_obtain(tmp));
-    exp answer_re  = f_bin_floating_mult(ov_err, minus_x_y, plus_x_y);
+    exp answer_re = f_bin_floating_mult(ov_err, minus_x_y, plus_x_y);
-    exp answer_im  = f_bin_floating_plus(ov_err, obtain1_tmp, obtain2_tmp);
+    exp answer_im = f_bin_floating_plus(ov_err, obtain1_tmp, obtain2_tmp);
     x = push(tmp, me_startid(sh(x), answer_re, 0));
     y = push(x, me_startid(sh(x), answer_im, 0));
     *arg1 = x;
     return;
+}
-static void mult_w_by_z
+static
-    PROTO_N ( (ov_err, arg1, arg2, arg3, arg4, arg5) )
+void mult_w_by_z(error_treatment ov_err, exp *arg1, exp *arg2, exp arg3,
-    PROTO_T ( error_treatment ov_err X exp *arg1 X exp *arg2 X exp arg3 X exp arg4 X exp arg5 )
+		 exp arg4, exp arg5)
+{
     exp u = *arg1;
     exp v = *arg2;
     exp x =  arg3;
     exp y =  arg4;
     exp mult_y_v = f_bin_floating_mult(ov_err, obtain2_y, obtain2_v);
     exp tmp = push(arg5, me_startid(sh(x), mult_y_u, 0));
     exp obtain_tmp = hold_check(me_obtain(tmp));
-    exp answer_re  = f_floating_minus(ov_err, mult_x_u, mult_y_v);
+    exp answer_re = f_floating_minus(ov_err, mult_x_u, mult_y_v);
-    exp answer_im  = f_bin_floating_plus(ov_err, mult_x_v, obtain_tmp);
+    exp answer_im = f_bin_floating_plus(ov_err, mult_x_v, obtain_tmp);
     u = push(tmp, me_startid(sh(x), answer_re, 0));
     v = push(u, me_startid(sh(x), answer_im, 0));
     *arg1 = u;
     return;
+}
-static exp make_comp_1_z
+static exp
-    PROTO_N ( (complex_fv, ov_err, contents1_u, contents2_u, contents3_u,
-	       contents1_v, contents2_v, contents3_v) )
-    PROTO_T ( floating_variety complex_fv X error_treatment ov_err X
+make_comp_1_z(floating_variety complex_fv, error_treatment ov_err,
-	      exp contents1_u X exp contents2_u X exp contents3_u X
+	      exp contents1_u, exp contents2_u, exp contents3_u,
-	      exp contents1_v X exp contents2_v X exp contents3_v )
+	      exp contents1_v, exp contents2_v, exp contents3_v)
+{
-    exp mult_u_u    = f_bin_floating_mult(ov_err, contents1_u, contents2_u);
+    exp mult_u_u = f_bin_floating_mult(ov_err, contents1_u, contents2_u);
-    exp mult_v_v    = f_bin_floating_mult(ov_err, contents1_v, contents2_v);
+    exp mult_v_v = f_bin_floating_mult(ov_err, contents1_v, contents2_v);
     exp mod_squared = f_bin_floating_plus(ov_err, mult_u_u, mult_v_v);
-    exp mod_sq      = me_startid(sh(contents1_u), mod_squared, 0);
+    exp mod_sq = me_startid(sh(contents1_u), mod_squared, 0);
     exp obtain1_mod_sq = me_obtain(mod_sq);
     exp obtain2_mod_sq = me_obtain(mod_sq);
     exp v_div_mod_sq = f_floating_div(ov_err, contents3_v, obtain2_mod_sq);
     exp answer_re = f_floating_div(ov_err, contents3_u, obtain1_mod_sq);
     exp answer_im = f_floating_negate(ov_err, v_div_mod_sq);
     exp make_comp = f_make_complex(complex_fv, answer_re, answer_im);
-    return  me_complete_id(mod_sq, make_comp);
+    return me_complete_id(mod_sq, make_comp);
+}
-#define is_const(X)  (name(X) != ident_tag)
+#define is_const(X)	(name(X) != ident_tag)
-exp_list reorder_list
+exp_list
-    PROTO_N ( (arg1, consts_first) )
-    PROTO_T ( exp_list arg1 X int consts_first )
+reorder_list(exp_list arg1, int consts_first)
+{
     exp type1_start, type1_end, type2_start, type2_end, t;
     type1_start = type1_end = type2_start = type2_end = nilexp;
     setbro(arg1.end, nilexp);
     for (t = arg1.start; t != arg1.end; t=bro(t)) {
 	if ((is_const(t) && consts_first) || !(is_const(t) || consts_first)) {
 	    if (type1_start == nilexp) {
-		type1_start = type1_end = t;                          /* first of type 1 */
+		type1_start = type1_end = t;	/* first of type 1 */
 	    } else {
-		setbro(type1_end, t);                        /* add to existing type 1's */
+		setbro(type1_end, t);		/* add to existing type 1's */
 		type1_end = t;
+	    }
 	} else {
 	    if (type2_start == nilexp) {
-		type2_start = type2_end = t;                          /* first of type 2 */
+		type2_start = type2_end = t;	/* first of type 2 */
 	    } else {
-		setbro(type2_end, t);                        /* add to existing type 2's */
+		setbro(type2_end, t);		/* add to existing type 2's */
 		type2_end = t;
+	    }
+	}
+    }
     if ((type1_start != nilexp) && (type2_start != nilexp)) {
 	arg1.start = type1_start;
-        setbro(type1_end, type2_start);                      /* if list is not a mixture */
+        setbro(type1_end, type2_start);	/* if list is not a mixture */
-	arg1.end = type2_end;                            /* no reordering has to be done */
+	arg1.end = type2_end;		/* no reordering has to be done */
+    }
     return arg1;
+}
-exp me_contents
+exp
-    PROTO_N ( (arg1) )
-    PROTO_T ( exp arg1 )
+me_contents(exp arg1)
+{
   exp r = me_u3(sh(arg1), me_obtain(arg1), cont_tag);
   return hold_check(r);
+}
      arg1 is the new element
      arg2 is the top element on the stack
  */
-static exp push
+static exp
-    PROTO_N ( (arg1, arg2) )
-    PROTO_T ( exp arg1 X exp arg2 )
+push(exp arg1, exp arg2)
+{
     setbro(arg2, arg1);
     return arg2;
+}
   /* Take the stack full of "ident_tag" declarations and link them
      together with the last element in the list being "last_link"
      and the body around which the declarations are put be "link_to".
   */
-static exp me_complete_chain
+static exp
-    PROTO_N ( (ident_chain, last_link, link_to) )
-    PROTO_T ( exp ident_chain X exp last_link X exp link_to )
+me_complete_chain(exp ident_chain, exp last_link, exp link_to)
+{
     exp remove_link;
     while (son(ident_chain) != last_link) {
 	remove_link = bro(ident_chain);
 	link_to = me_complete_id(ident_chain, link_to);
 	ident_chain = remove_link;
-    };
+    }
     return me_complete_id(ident_chain, link_to);
+}
 /* Binary version of 'f_floating_plus' */
-static exp f_bin_floating_plus
+static exp
-    PROTO_N ( (ov_err, arg1, arg2) )
-    PROTO_T ( error_treatment ov_err X exp arg1 X exp arg2 )
+f_bin_floating_plus(error_treatment ov_err, exp arg1, exp arg2)
+{
   exp_list el;
   el = new_exp_list(2);
   el = add_exp_list(el, arg1, 0);
   el = add_exp_list(el, arg2, 1);
-  return f_floating_plus (ov_err,el);
+  return f_floating_plus(ov_err, el);
+}
 /* Binary version of 'f_floating_mult' */
-static exp f_bin_floating_mult
+static exp
-    PROTO_N ( (ov_err, arg1, arg2) )
-    PROTO_T ( error_treatment ov_err X exp arg1 X exp arg2 )
+f_bin_floating_mult(error_treatment ov_err, exp arg1, exp arg2)
+{
   exp_list el;
   el = new_exp_list(2);
   el = add_exp_list(el, arg1, 0);
   el = add_exp_list(el, arg2, 1);
-  return f_floating_mult (ov_err,el);
+  return f_floating_mult(ov_err, el);
+}
-static exp optimise_with_wrap
+static exp
-    PROTO_N ( (arg, shape1, shape2) )
-    PROTO_T ( exp arg X shape shape1 X shape shape2 )
+optimise_with_wrap(exp arg, shape shape1, shape shape2)
+{
-  if (! eq_shape(shape1,shape2))
+  if (!eq_shape(shape1, shape2)) {
-    return  f_change_variety (f_wrap, shape2, arg);
+    return f_change_variety(f_wrap, shape2, arg);
+  }
-  return (arg);
+  return(arg);
+}
-static exp real_power
+static exp
-    PROTO_N ( (ov_err, arg1, arg2) )
-    PROTO_T ( error_treatment ov_err X exp arg1 X exp arg2 )
+real_power(error_treatment ov_err, exp arg1, exp arg2)
+{
     /* Gives shorter .s file if n<10 and arg1 is unknown */
     exp real1, sn;
-    exp (*f_real_mult) PROTO_S ((error_treatment, exp, exp));
+    exp(*f_real_mult)(error_treatment, exp, exp);
     shape real_shape, integer_shape, tmp_shape;
 /* With wrap, we may as well work with 'int's and change back after */
     tmp_shape = sh(arg1);
     if (is_integer(tmp_shape) && !is_signed(tmp_shape) &&
-	shape_size(sh(arg1)) < 32 &&
+	shape_size(sh(arg1)) < 32 && eq_et(ov_err, f_wrap)) {
-	eq_et(ov_err, f_wrap))
-    {
-	arg1 = hold_check (f_change_variety (f_impossible, ulongsh, arg1));
+	arg1 = hold_check(f_change_variety(f_impossible, ulongsh, arg1));
     }
 /* Widen to 'int' if necessary - guarantees negate will work */
     if (shape_size(sh(arg2)) < 32) {
-	arg2 = hold_check (f_change_variety (f_impossible, slongsh, arg2));
+	arg2 = hold_check(f_change_variety(f_impossible, slongsh, arg2));
+    }
-    real_shape = sh(arg1);                       /* shape of the result */
+    real_shape = sh(arg1);	/* shape of the result */
     integer_shape = sh(arg2);
     sn = me_startid(integer_shape, arg2, 0);
 /* Identify an exp which represents the value 1 (or 1.0) */
     if (is_integer(real_shape)) {
 	real1 = me_shint(real_shape,1);
-    }
-    else {
+    } else {
 	real1 = me_shint(integer_shape,1);
-	real1 = f_float_int (f_impossible, fv_of_shape(real_shape), real1);
+	real1 = f_float_int(f_impossible, fv_of_shape(real_shape), real1);
-	real1 = hold_check (real1);		/* This should be reduced to 1.0 */
+	real1 = hold_check (real1);	/* This should be reduced to 1.0 */
+    }
-    real1 = push (sn, me_startid(real_shape, real1, 0));
+    real1 = push(sn, me_startid(real_shape, real1, 0));
 /* Decide which is the suitable function for multiplying two numbers */
-    f_real_mult = (is_integer(real_shape) ? f_mult : f_bin_floating_mult);
+    f_real_mult = (is_integer(real_shape)? f_mult : f_bin_floating_mult);
     if (is_constant_arg(arg2) ||
-	((name(arg2) == name_tag) && (name(son(arg2)) == ident_tag)
+	((name(arg2) == name_tag) && (name(son(arg2)) == ident_tag) &&
-	   && !isvar(son(arg2)) && is_constant_arg(son(son(arg2)))))
+	 !isvar(son(arg2)) && is_constant_arg(son(son(arg2))))) {
-    {                                                                /* we know the power */
+	/* we know the power */
 	int exponent;
 	exp x;
 	if (is_constant_arg(arg2)) {
 	    exponent = no(arg2);	/* arg2 is a constant */
-	}
-	else {
+	} else {
 	    exponent = no(son(son(arg2)));
 		/* arg2 identifies a constant */
 	}
 	if (exponent < 0) {
 	    if (is_integer(real_shape)) {
 		failer("constant value out of range: power: must be non-negative");
-	    }
+	    } else {
-	    else {        	/* take reciprocal */
+		/* take reciprocal */
-		arg1 = hold_check (f_floating_div (ov_err, me_obtain(real1), arg1));
+		arg1 = hold_check(f_floating_div(ov_err, me_obtain(real1),
+						 arg1));
 	    }
 	}
-	x = push (real1, me_startid(real_shape, arg1, 0));
+	x = push(real1, me_startid(real_shape, arg1, 0));
 	if (exponent == 0) {
-	    return  me_complete_chain (x, arg2, optimise_with_wrap (
+	    return me_complete_chain(x, arg2,
+				     optimise_with_wrap(me_obtain(real1),
-			   me_obtain(real1), real_shape, tmp_shape));
+							real_shape, tmp_shape));
 	}
+	{
-	    exp  w, mylast = x;
+	    exp w, mylast = x;
 	    int n = abs(exponent);
 	    while ((n % 2) == 0) {
 		exp mult_x_x;
 		mult_x_x = (*f_real_mult)(ov_err, me_obtain(x), me_obtain(x));
-		mylast = x = push (mylast,
+		mylast = x = push(mylast, me_startid(real_shape,
-			 me_startid(real_shape, hold_check(mult_x_x), 0));
+						     hold_check(mult_x_x), 0));
 		n = n / 2;
 	    }
 	    if (n == 1) {
+		/* return x  */
-		return  me_complete_chain (x, arg2, optimise_with_wrap (
+		return me_complete_chain(x, arg2,
-				me_obtain(x), real_shape, tmp_shape));        /* return x  */
+					 optimise_with_wrap(me_obtain(x),
+							    real_shape,
+							    tmp_shape));
 	    }
+	    else {
-	    else {                      	                             /*  w = x  */
+		/*  w = x  */
-		mylast = w = push (x, me_startid(real_shape, me_obtain(x), 0));
+		mylast = w = push(x, me_startid(real_shape, me_obtain(x), 0));
+	    }
 	    while (n != 1) {
 		exp mult_x_x;
 		mult_x_x = (*f_real_mult)(ov_err, me_obtain(x), me_obtain(x));
-		mylast = x = push (mylast,
+		mylast = x = push(mylast, me_startid(real_shape,
-			me_startid(real_shape, hold_check(mult_x_x), 0));
+						     hold_check(mult_x_x), 0));
 		n = n / 2;
 		if ((n % 2) == 1) {
 		    exp mult_w_x;
-		    mult_w_x = (*f_real_mult)(ov_err, me_obtain(w), me_obtain(x));
+		    mult_w_x = (*f_real_mult)(ov_err, me_obtain(w),
+					      me_obtain(x));
-		    mylast = w = push (mylast,
+		    mylast = w = push(mylast, me_startid(real_shape,
-			me_startid(real_shape, hold_check(mult_w_x), 0));
+							 hold_check(mult_w_x),
+));
+		}
+	    }
+	    /*  return w  */
-	    return  me_complete_chain (w, arg2, optimise_with_wrap (
+	    return me_complete_chain(w, arg2, optimise_with_wrap(me_obtain(w),
+								 real_shape,
-				me_obtain(w), real_shape, tmp_shape));    /*  return w  */
+								 tmp_shape));
+	}
     } else {
-	exp  reinitialise_w, main_loop, make_comp;              /* main building blocks */
+	exp reinitialise_w, main_loop, make_comp; /* main building blocks */
-	exp  square_x, mult_x_w, half_n, update_w, repeat_body;
+	exp square_x, mult_x_w, half_n, update_w, repeat_body;
-	exp  seq, w, x, n;
+	exp seq, w, x, n;
 	n = me_obtain(sn);
-	if (!is_integer(real_shape)) {	/* Must be positive for integer powers */
+	if (!is_integer(real_shape)) { /* Must be positive for integer powers */
-	    n = f_abs (f_impossible, n);
+	    n = f_abs(f_impossible, n);
 	}
-	n = push (real1, me_startid (integer_shape, n, 1));
+	n = push(real1, me_startid(integer_shape, n, 1));
-	w = push (n, me_startid(real_shape, me_obtain(real1), 1));
+	w = push(n, me_startid(real_shape, me_obtain(real1), 1));
-	x = push (w, me_startid(real_shape, arg1, 1));
+	x = push(w, me_startid(real_shape, arg1, 1));
 	/*  change value of w to z if n is odd  */
 	{
-	    exp rem_n_2 = f_and (me_contents(n), me_shint(integer_shape, 1));
+	    exp rem_n_2 = f_and(me_contents(n), me_shint(integer_shape, 1));
-	    exp assign_w = f_assign (me_obtain(w), me_contents(x));
+	    exp assign_w = f_assign(me_obtain(w), me_contents(x));
 	    exp alt_labst = hold_check(me_b3(f_top, f_make_value(f_top),
-					       f_make_top(), labst_tag));
+					     f_make_top(), labst_tag));
-	    exp is_n_odd = f_integer_test (no_nat_option, f_equal, make_label(alt_labst),
+	    exp is_n_odd = f_integer_test(no_nat_option, f_equal,
+					  make_label(alt_labst), rem_n_2,
-				rem_n_2, me_shint(integer_shape, 1));
+					  me_shint(integer_shape, 1));
-	    exp seq = f_sequence (add_exp_list(new_exp_list(1), is_n_odd, 0), assign_w);
+	    exp seq = f_sequence(add_exp_list(new_exp_list(1), is_n_odd, 0),
+				 assign_w);
 	    reinitialise_w = hold_check(me_b3(lub_shape(sh(seq),sh(alt_labst)),
 					      seq, alt_labst, cond_tag));
 	}
 	/*  x=x*x  */
+	{
 	    exp mult_x_x;
-	    mult_x_x = (*f_real_mult) (ov_err, me_contents(x), me_contents(x));
+	    mult_x_x = (*f_real_mult)(ov_err, me_contents(x), me_contents(x));
-	    square_x = f_assign (me_obtain(x), mult_x_x);
+	    square_x = f_assign(me_obtain(x), mult_x_x);
+	}
 	/*  w=x*w  */
 	{
 	    exp answer;
 	    answer = (*f_real_mult)(ov_err, me_contents(x), me_contents(w));
-	    mult_x_w = f_assign (me_obtain(w), answer);
+	    mult_x_w = f_assign(me_obtain(w), answer);
+	}
-	/*  n=n/2  */
+	/*  n = n / 2  */
+	{
-	    exp answer = f_shift_right (me_contents(n), me_shint(integer_shape, 1));
+	    exp answer = f_shift_right(me_contents(n),
+				       me_shint(integer_shape, 1));
-	    half_n = f_assign (me_obtain(n), answer);
+	    half_n = f_assign(me_obtain(n), answer);
+	}
-	/*  if n is odd then w = z*w  */
+	/*  if n is odd then w = z * w  */
+	{
-	    exp rem_n_2 = f_and (me_contents(n), me_shint(integer_shape, 1));
+	    exp rem_n_2 = f_and(me_contents(n), me_shint(integer_shape, 1));
 	    exp alt_labst = hold_check(me_b3(f_top, f_make_value(f_top),
 					     f_make_top(), labst_tag));
-	    exp is_n_odd = f_integer_test (no_nat_option, f_equal, make_label(alt_labst),
+	    exp is_n_odd = f_integer_test(no_nat_option, f_equal,
+					  make_label(alt_labst),
-					   rem_n_2, me_shint(integer_shape, 1));
+					  rem_n_2, me_shint(integer_shape, 1));
-	    exp seq = f_sequence (add_exp_list(new_exp_list(1),
+	    exp seq = f_sequence(add_exp_list(new_exp_list(1),
-					is_n_odd, 0), mult_x_w);
+					      is_n_odd, 0), mult_x_w);
 	    update_w = hold_check(me_b3(lub_shape(sh(seq),sh(alt_labst)),
 					seq, alt_labst, cond_tag));
+	}
 	/*  repeat + body  */
+	{
 	    exp body_labst, if_n_equals_1;
 	    exp_list st;
-	    body_labst = hold_check(me_b3(f_top, f_make_value(f_top), f_make_top(), labst_tag));
+	    body_labst = hold_check(me_b3(f_top, f_make_value(f_top),
+					  f_make_top(), labst_tag));
-	    if_n_equals_1 = f_integer_test (no_nat_option, f_equal, make_label(body_labst),
+	    if_n_equals_1 = f_integer_test(no_nat_option, f_equal,
+					   make_label(body_labst),
+					   me_contents(n),
-					    me_contents(n), me_shint(integer_shape, 1));
+					   me_shint(integer_shape, 1));
 	    st = new_exp_list(1);
 	    st = add_exp_list(st, square_x, 0);
 	    st = add_exp_list(st, half_n, 1);
 	    st = add_exp_list(st, update_w, 2);
-	    seq = f_sequence (st, if_n_equals_1);
+	    seq = f_sequence(st, if_n_equals_1);
-	    setbro (son(body_labst), seq);
+	    setbro(son(body_labst), seq);
-	    setsh (body_labst, sh (seq));                    /*  put seq into the body  */
+	    setsh (body_labst, sh (seq));	/*  put seq into the body  */
-	    clearlast (son(body_labst));                     /*  of the labst           */
+	    clearlast (son(body_labst));	/*  of the labst           */
-	    setfather (body_labst, seq);
+	    setfather(body_labst, seq);
-	    repeat_body = hold_check(me_b3(sh(body_labst), f_make_top(), body_labst, rep_tag));
+	    repeat_body = hold_check(me_b3(sh(body_labst), f_make_top(),
+					   body_labst, rep_tag));
 	    note_repeat(repeat_body);
+	}
 	/*  make loop - only done if  mod(n) > 1  */
+	{
 	    exp alt_labst = hold_check(me_b3(f_top, f_make_value(f_top),
-					   f_make_top(), labst_tag));
+					     f_make_top(), labst_tag));
-	    exp is_n_gt_1 = f_integer_test (no_nat_option, f_greater_than, make_label(alt_labst),
+	    exp is_n_gt_1 = f_integer_test(no_nat_option, f_greater_than,
+					   make_label(alt_labst),
+					   me_contents(n),
-					    me_contents(n), me_shint(integer_shape, 1));
+					   me_shint(integer_shape, 1));
-	    exp seq = f_sequence (add_exp_list(new_exp_list(1),
+	    exp seq = f_sequence(add_exp_list(new_exp_list(1),
-					 is_n_gt_1, 0), repeat_body);
+					      is_n_gt_1, 0), repeat_body);
 	    main_loop = hold_check(me_b3(lub_shape(sh(seq),sh(alt_labst)),
 					 seq, alt_labst, cond_tag));
+	}
 	if (is_integer(real_shape)) {
 	    make_comp = me_contents(w);
-	}
-	else {
+	} else {
-	    exp make_comp2 = f_floating_div(ov_err, me_obtain(real1), me_contents(w));
+	    exp make_comp2 = f_floating_div(ov_err, me_obtain(real1),
+					    me_contents(w));
 	    exp alt_labst = hold_check(me_b3(real_shape, f_make_value(f_top),
 					     make_comp2, labst_tag));
-	    exp is_arg2_positive = f_integer_test (no_nat_option, f_greater_than_or_equal,
+	    exp is_arg2_positive = f_integer_test(no_nat_option,
+						  f_greater_than_or_equal,
-					       make_label(alt_labst), me_obtain(sn),
+						  make_label(alt_labst),
+						  me_obtain(sn),
-					       me_shint(integer_shape, 0));
+						  me_shint(integer_shape, 0));
-	    exp seq = f_sequence (add_exp_list(new_exp_list(1),
+	    exp seq = f_sequence(add_exp_list(new_exp_list(1),
-			       	is_arg2_positive, 0), me_contents(w));
+					      is_arg2_positive, 0),
+				 me_contents(w));
-	    make_comp = hold_check(me_b3(lub_shape(sh(seq),sh(alt_labst)),
+	    make_comp = hold_check(me_b3(lub_shape(sh(seq),sh(alt_labst)), seq,
-					 seq, alt_labst, cond_tag));
+					 alt_labst, cond_tag));
+	}
-	seq = f_sequence (add_exp_list (add_exp_list(new_exp_list(1),
+	seq = f_sequence(add_exp_list(add_exp_list(new_exp_list(1),
+						   reinitialise_w, 0),
-				reinitialise_w, 0), main_loop, 1), make_comp);
+				      main_loop, 1), make_comp);
-	seq = optimise_with_wrap (seq, real_shape, tmp_shape);
+	seq = optimise_with_wrap(seq, real_shape, tmp_shape);
 	return  me_complete_chain(x, arg2, seq);
+    }
+}

Subversion Repositories tendra.SVN

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