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

+/*
+ * Copyright (c) 2002-2006 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
  * unsigned cases
+ *
  * Revision 1.78  1996/11/11  10:05:39  currie
  * current_env on hppa
+ *
-Revision 1.77  1996/10/29 10:10:46  currie
+ * Revision 1.77  1996/10/29 10:10:46  currie
-bit alignment for hppa
+ * 512 bit alignment for hppa
+ *
  * Revision 1.76  1996/10/21  08:53:55  currie
  * long_jump_access
+ *
-Revision 1.75  1996/10/01 08:59:22  currie
+ * Revision 1.75  1996/10/01 08:59:22  currie
-correct chvar exceptions ADA
+ * correct chvar exceptions ADA
+ *
-Revision 1.74  1996/09/04 14:44:40  currie
+ * Revision 1.74  1996/09/04 14:44:40  currie
-mis-spelling
+ * mis-spelling
+ *
-Revision 1.73  1996/09/04 14:19:55  currie
+ * Revision 1.73  1996/09/04 14:19:55  currie
-mis-spelling
+ * mis-spelling
+ *
-Revision 1.71  1996/07/05 15:45:09  currie
+ * Revision 1.71  1996/07/05 15:45:09  currie
-initial values
+ * initial values
+ *
-Revision 1.70  1996/06/19 11:50:36  currie
+ * Revision 1.70  1996/06/19 11:50:36  currie
-Parameter alignments in make_coumpound
+ * Parameter alignments in make_coumpound
+ *
-Revision 1.69  1996/06/18 09:20:55  currie
+ * Revision 1.69  1996/06/18 09:20:55  currie
-C torture long nats
+ * C torture long nats
+ *
-Revision 1.68  1996/06/05 15:29:54  currie
+ * Revision 1.68  1996/06/05 15:29:54  currie
-parameter alignment in make_cmpd
+ * parameter alignment in make_cmpd
+ *
-Revision 1.67  1996/05/14 10:39:14  currie
+ * Revision 1.67  1996/05/14 10:39:14  currie
-Long unsigned div2
+ * Long unsigned div2
+ *
-Revision 1.66  1996/05/02 09:34:44  currie
+ * Revision 1.66  1996/05/02 09:34:44  currie
-Empty caselim list
+ * Empty caselim list
+ *
-Revision 1.65  1996/04/02 10:34:16  currie
+ * Revision 1.65  1996/04/02 10:34:16  currie
-volatile & trap_on_nil
+ * volatile & trap_on_nil
+ *
  * Revision 1.63  1996/03/28  11:33:48  currie
  * Hppa struct params + outpar+init names
+ *
  * Revision 1.62  1996/03/12  09:45:20  currie
  * promote pars
  * Revision 1.60  1996/02/28  11:36:20  currie
  * assign to promoted pars
+ *
  * Revision 1.59  1996/02/26  11:54:22  currie
  * Various odds and ends
  *
  * Revision 1.58  1996/02/21  09:39:02  currie
  * hppa var_callers + inlined bug
+ *
  * Revision 1.57  1996/01/25  17:02:53  currie
  * Struct params in sparc + postludes
  * mjg mods
+ *
  * Revision 1.23  1995/08/21  09:38:35  currie
  * no_trap_on_nill_contents
+ *
  * Revision 1.23  1995/08/21  09:38:35  currie
  * no_trap_on_nill_contents
+ *
  * Revision 1.22  1995/08/18  09:03:28  currie
  * Float variety adjusted
+ *
  * Revision 1.21  1995/08/15  08:25:31  currie
+ *
 ***********************************************************************/
-  /* This file defines procedures called from decoder which make up
+/* This file defines procedures called from decoder which make up
-     the internal representations of the various sorts of value.
+   the internal representations of the various sorts of value.
-     In most cases the construction of these is evident from the
+   In most cases the construction of these is evident from the
-     specification and the document describing the in-store
+   specification and the document describing the in-store
-     representation: the function merely creates the corresponding value.
+   representation: the function merely creates the corresponding value.
-     In some cases processing is performed: it is only these which are
+   In some cases processing is performed: it is only these which are
-     commented.
+   commented.
-     Many constructions have the shape of their arguments checked by
+   Many constructions have the shape of their arguments checked by
-     check_shape. These checks are implied by the specification and are
+   check_shape. These checks are implied by the specification and are
-     not commented.
+   not commented.
-  */
+*/
 #include "config.h"
 #include <ctype.h>
 #include <time.h>
 #ifdef NEWDIAGS
 #include "dg_fns.h"
 #include "mark_scope.h"
 #endif
-#define NOTYETDONE(x) failer(x)
+#define NOTYETDONE(x)	failer(x)
 #define MAX_ST_LENGTH 25
 /* All variables initialised */
 procprops f_no_long_jump_dest = 16;
 procprops f_inline = 32;
 static proc_props initial_value_pp;
-procprops f_add_procprops
+procprops
-    PROTO_N ( (t,e) )
-    PROTO_T ( procprops t X procprops e )
+f_add_procprops(procprops t, procprops e)
+{
-     return (t|e);
+	return (t | e);
+}
-procprops no_procprops_option = 0;
-procprops yes_procprops_option
+procprops no_procprops_option = 0;
-    PROTO_N ( (p) )
+procprops
-    PROTO_T ( procprops p )
+yes_procprops_option(procprops p)
+{
 	return p;
+}
+void
-void init_procprops_option
+init_procprops_option(void)
-    PROTO_Z ()
 {
 	return;
 }
 error_code f_overflow  = 7;
 error_code f_nil_access = 19;
 error_code f_stack_overflow = 35;
-error_code_list add_error_code_list
+error_code_list
-    PROTO_N ( (t, e, i) )
-    PROTO_T ( error_code_list t X error_code e X int i )
+add_error_code_list(error_code_list t, error_code e, int i)
 {
-	UNUSED (i);
+	UNUSED(i);
-	return(t | e);
+	return (t | e);
 }
-error_code_list new_error_code_list
+error_code_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
+new_error_code_list(int n)
 {
-	UNUSED (n);
+	UNUSED(n);
 	return 0;
 }
 transfer_mode f_trap_on_nil = 8;
-shape containedshape
+shape
-    PROTO_N ( (a, s) )
-    PROTO_T ( int a X int s )
+containedshape(int a, int s)
 {
-	switch((a+7)&~7) {
+	switch ((a + 7) & ~7) {
+	case 8:
+	case 0:
-	case 8: case 0: return ((s)?scharsh:ucharsh);
+		return ((s) ? scharsh : ucharsh);
+	case 16:
-	case 16: return ((s)?swordsh:uwordsh);
+		return ((s) ? swordsh : uwordsh);
+	case 32:
+	case 24:
-	case 32: case 24: return ((s)?slongsh:ulongsh);
+		return ((s) ? slongsh : ulongsh);
+	case 64:
+	case 40:
+	case 48:
+	case 56:
-	case 64: case 40: case 48: case 56: return ((s)?s64sh:u64sh);
+		return ((s) ? s64sh : u64sh);
+	default:
-	default: failer("Illegal pointer for bitfield operations");
+		failer("Illegal pointer for bitfield operations");
 		return scharsh;
+	}
 }
-dec * make_extra_dec
+dec *
-    PROTO_N ( (nme, v, g, init, s) )
-    PROTO_T ( char * nme X int v X int g X exp init X shape s )
+make_extra_dec(char *nme, int v, int g, exp init, shape s)
 {
-    dec * extra_dec = (dec *)calloc(1, sizeof(dec));
+	dec *extra_dec = (dec *)calloc(1, sizeof(dec));
-    exp e = getexp(s, nilexp, 0, init, nilexp, 0, 0, ident_tag);
+	exp e = getexp(s, nilexp, 0, init, nilexp, 0, 0, ident_tag);
-    setglob(e);
+	setglob(e);
+	if (v) {
-    if (v) setvar(e);
+		setvar(e);
+	}
-    brog(e) = extra_dec;
+	brog(e) = extra_dec;
-    extra_dec -> def_next = (dec *)0;
+	extra_dec->def_next = (dec *)0;
-    *deflist_end = extra_dec;
+	*deflist_end = extra_dec;
-    deflist_end = &((*deflist_end) -> def_next);
+	deflist_end = &((*deflist_end)->def_next);
-    extra_dec -> dec_u.dec_val.dec_id = nme;
+	extra_dec->dec_u.dec_val.dec_id = nme;
-    extra_dec -> dec_u.dec_val.dec_shape = s;
+	extra_dec->dec_u.dec_val.dec_shape = s;
-    extra_dec -> dec_u.dec_val.dec_exp = e;
+	extra_dec->dec_u.dec_val.dec_exp = e;
-    extra_dec -> dec_u.dec_val.unit_number = crt_tagdef_unit_no;
+	extra_dec->dec_u.dec_val.unit_number = crt_tagdef_unit_no;
-    extra_dec -> dec_u.dec_val.diag_info = (diag_global *)0;
+	extra_dec->dec_u.dec_val.diag_info = (diag_global *)0;
-    extra_dec -> dec_u.dec_val.extnamed = (unsigned int) g;
+	extra_dec->dec_u.dec_val.extnamed = (unsigned int)g;
-    extra_dec -> dec_u.dec_val.dec_var = (unsigned int) v;
+	extra_dec->dec_u.dec_val.dec_var = (unsigned int)v;
-    extra_dec -> dec_u.dec_val.dec_outermost = 0;
+	extra_dec->dec_u.dec_val.dec_outermost = 0;
-    extra_dec -> dec_u.dec_val.have_def = init != nilexp;
+	extra_dec->dec_u.dec_val.have_def = init != nilexp;
-    extra_dec -> dec_u.dec_val.processed = 0;
+	extra_dec->dec_u.dec_val.processed = 0;
-    extra_dec -> dec_u.dec_val.isweak = 0;
+	extra_dec->dec_u.dec_val.isweak = 0;
-    extra_dec -> dec_u.dec_val.is_common = 0;
+	extra_dec->dec_u.dec_val.is_common = 0;
-    if (init != nilexp) { setfather(e, init); }
+	if (init != nilexp) {
+		setfather(e, init);
+	}
-    return extra_dec;
+	return extra_dec;
 }
-dec * find_named_dec
+dec *
-    PROTO_N ( (n) )
-    PROTO_T ( char * n )
+find_named_dec(char *n)
 {
-  /* find a global with name n */
+	/* find a global with name n */
-  dec * my_def = top_def;
+	dec *my_def = top_def;
-  while (my_def != (dec *) 0){
+	while (my_def != (dec *)0) {
-    char *id = my_def -> dec_u.dec_val.dec_id;
+		char *id = my_def->dec_u.dec_val.dec_id;
-    if (strcmp(id+strlen(name_prefix), n) == 0) return my_def;
+		if (strcmp(id + strlen(name_prefix), n) == 0) {
+			return my_def;
+		}
-    my_def = my_def->def_next;
+		my_def = my_def->def_next;
-  }
+	}
-  return (dec*)0;
+	return (dec *)0;
 }
-exp find_named_tg
+exp
-    PROTO_N ( (n, s) )
-    PROTO_T ( char * n X shape s )
+find_named_tg(char *n, shape s)
 {
-  /* find a global with name n */
+	/* find a global with name n */
-  dec * my_def = find_named_dec(n);
+	dec *my_def = find_named_dec(n);
-  if (my_def != (dec*)0) {
+	if (my_def != (dec*)0) {
-	return my_def -> dec_u.dec_val.dec_exp;
+		return my_def->dec_u.dec_val.dec_exp;
-  }
+	}
-  my_def = make_extra_dec(add_prefix(n), 0, 1, nilexp, s);
+	my_def = make_extra_dec(add_prefix(n), 0, 1, nilexp, s);
-  return my_def -> dec_u.dec_val.dec_exp;
+	return my_def->dec_u.dec_val.dec_exp;
+}
 #if !has64bits
-char * fn_of_op
+char *
-    PROTO_N ( (nm, sngd) )
-    PROTO_T ( int nm X int sngd )
+fn_of_op(int nm, int sngd)
+{
 	/* Find a run-time library fn corresponding to nm */
-#define CSU(x,y) return (sngd)?x:y
+#define CSU(x, y)	return (sngd) ? x : y
 	switch (nm) {
+	case plus_tag:
-	  case plus_tag: CSU("__TDFUs_plus","__TDFUu_plus");
+		CSU("__TDFUs_plus", "__TDFUu_plus");
+	case minus_tag:
-	  case minus_tag: CSU("__TDFUs_minus","__TDFUu_minus");
+		CSU("__TDFUs_minus", "__TDFUu_minus");
+	case mult_tag:
-	  case mult_tag: CSU("__TDFUs_mult","__TDFUu_mult");
+		CSU("__TDFUs_mult", "__TDFUu_mult");
+	case div0_tag:
+	case div2_tag:
-	  case div0_tag:case div2_tag: CSU("__TDFUs_div2","__TDFUu_div2");
+		CSU("__TDFUs_div2", "__TDFUu_div2");
+	case div1_tag:
-	  case div1_tag: CSU("__TDFUs_div1","__TDFUu_div2");
+		CSU("__TDFUs_div1", "__TDFUu_div2");
+	case rem0_tag:
+	case rem2_tag:
-	  case rem0_tag:case rem2_tag: CSU("__TDFUs_rem2","__TDFUu_rem2");
+		CSU("__TDFUs_rem2", "__TDFUu_rem2");
+	case mod_tag:
-	  case mod_tag: CSU("__TDFUs_rem1","__TDFUu_rem2");
+		CSU("__TDFUs_rem1", "__TDFUu_rem2");
+	case shl_tag:
-	  case shl_tag: CSU("__TDFUs_shl","__TDFUu_shl");
+		CSU("__TDFUs_shl", "__TDFUu_shl");
+	case shr_tag:
-	  case shr_tag: CSU("__TDFUs_shr","__TDFUu_shr");
+		CSU("__TDFUs_shr", "__TDFUu_shr");
+	case neg_tag:
-	  case neg_tag: return "__TDFUneg";
+		return "__TDFUneg";
+	case abs_tag:
-	  case abs_tag: return "__TDFUabs";
+		return "__TDFUabs";
+	case chvar_tag:
-	  case chvar_tag:CSU("__TDFUs_chvar","__TDFUu_chvar");
+		CSU("__TDFUs_chvar", "__TDFUu_chvar");
+	case max_tag:
-	  case max_tag:	CSU("__TDFUs_max","__TDFUu_max");
+		CSU("__TDFUs_max", "__TDFUu_max");
+	case min_tag:
-	  case min_tag:	CSU("__TDFUs_min","__TDFUu_min");
+		CSU("__TDFUs_min", "__TDFUu_min");
+	case test_tag:
-	  case test_tag:CSU("__TDFUs_test","__TDFUu_test");
+		CSU("__TDFUs_test", "__TDFUu_test");
+	case float_tag:
-	  case float_tag: CSU("__TDFUs_float","__TDFUu_float");
+		CSU("__TDFUs_float", "__TDFUu_float");
+	case and_tag:
-	  case and_tag: return "__TDFUand";
+		return "__TDFUand";
+	case or_tag:
-	  case or_tag: return "__TDFUor";
+		return "__TDFUor";
+	case xor_tag:
-	  case xor_tag: return "__TDFUxor";
+		return "__TDFUxor";
+	case not_tag:
-	  case not_tag: return "__TDFUnot";
+		return "__TDFUnot";
+	default:
-	  default: failer("No fn for long op");
+		failer("No fn for long op");
+	}
 	return "__TDFerror";
 }
-exp TDFcallop3
+exp
-    PROTO_N ( (arg1, arg2, n) )
-    PROTO_T ( exp arg1 X exp arg2 X int n )
+TDFcallop3(exp arg1, exp arg2, int n)
 {
 	/* construct proc call for binary op corresponding to n */
-	char * nm = fn_of_op(n, is_signed(sh(arg1)));
+	char *nm = fn_of_op(n, is_signed(sh(arg1)));
 	exp dc;
 	exp ob;
 	exp_list pars;
 	exp_option novar;
 	exp res;
 	novar.present = 0;
 	dc = find_named_tg(nm, f_proc);
 	ob = me_obtain(dc);
 	pars.number = 2;
 	pars.start = arg1;
 	pars.end = arg2;
-	bro(arg1) = arg2; clearlast(arg1);
+	bro(arg1) = arg2;
+	clearlast(arg1);
 	res = f_apply_proc(sh(arg1), ob, pars, novar);
 	res = hold_check(res);
 	return res;
+}
-exp TDFwithet
+exp
-    PROTO_N ( (ov_err, e) )
-    PROTO_T ( error_treatment ov_err X exp e )
+TDFwithet(error_treatment ov_err, exp e)
+{
 	exp id;
 	exp c;
 	exp_list el;
 	exp Te;
-	if (ov_err.err_code <= 2) return e;
+	if (ov_err.err_code <= 2) {
+		return e;
+	}
-	Te = find_named_tg("__TDFerror",slongsh);
+	Te = find_named_tg("__TDFerror", slongsh);
-	brog(Te) -> dec_u.dec_val.dec_var = 1;
+	brog(Te)->dec_u.dec_val.dec_var = 1;
 #if keep_PIC_vars
-        setvar(Te);
+	setvar(Te);
 #else
-        if (PIC_code)
+	if (PIC_code) {
-          sh(Te) = f_pointer(f_alignment(slongsh));
+		sh(Te) = f_pointer(f_alignment(slongsh));
-        else
+	} else {
-          setvar(Te);
+		setvar(Te);
+	}
 #endif
 	id = me_startid(sh(e), e, 0);
 	c = f_contents(slongsh, me_obtain(Te));
 	el = new_exp_list(1);
-	el = add_exp_list(el, f_plus(ov_err,
+	el = add_exp_list(el, f_plus(ov_err, me_shint(slongsh, (int)0x80000000),
-			me_shint(slongsh, (int)0x80000000), c), 0);
+				     c), 0);
 	return me_complete_id(id, f_sequence(el, me_obtain(id)));
+}
-exp TDFcallop2
+exp
-    PROTO_N ( (ov_err,arg1, arg2, n) )
-    PROTO_T ( error_treatment ov_err X exp arg1 X exp arg2 X int n )
+TDFcallop2(error_treatment ov_err, exp arg1, exp arg2, int n)
+{
 	/* construct proc call for binary op corresponding to n */
 	/* ignore error treatment for the moment */
-	char * nm = fn_of_op(n, is_signed(sh(arg1)));
+	char *nm = fn_of_op(n, is_signed(sh(arg1)));
 	exp dc;
 	exp ob;
 	exp_list pars;
 	exp_option novar;
 	exp res;
 	dc = find_named_tg(nm, f_proc);
 	ob = me_obtain(dc);
 	pars.number = 2;
 	pars.start = arg1;
 	pars.end = arg2;
-	bro(arg1) = arg2; clearlast(arg1);
+	bro(arg1) = arg2;
+	clearlast(arg1);
 	res = f_apply_proc((n==test_tag)?slongsh:sh(arg1), ob, pars, novar);
-	return TDFwithet(ov_err,res);
+	return TDFwithet(ov_err, res);
+}
-exp TDFcallaux
+exp
-    PROTO_N ( (ov_err,arg1, nm, s) )
-    PROTO_T ( error_treatment ov_err X exp arg1 X char * nm X shape s )
+TDFcallaux(error_treatment ov_err, exp arg1, char *nm, shape s)
+{
 	exp dc;
 	exp ob;
 	exp_list pars;
 	exp_option novar;
 	pars.start = arg1;
 	pars.end = arg1;
 	res = f_apply_proc(s, ob, pars, novar);
 	res = hold_check(res);
-	return TDFwithet(ov_err,res);
+	return TDFwithet(ov_err, res);
 }
 exp TDFcallop1
-    PROTO_N ( (ov_err,arg1, n) )
-    PROTO_T ( error_treatment ov_err X exp arg1 X int n )
+(error_treatment ov_err, exp arg1, int n)
 {
 	/* construct proc call for unary op corresponding to n */
 	/* ignore error treatment for the moment */
-	char * nm = fn_of_op(n, is_signed(sh(arg1)));
+	char *nm = fn_of_op(n, is_signed(sh(arg1)));
-	return TDFcallaux(ov_err,arg1,nm, sh(arg1));
+	return TDFcallaux(ov_err, arg1, nm, sh(arg1));
+}
-exp TDFcallop4
+exp
-    PROTO_N ( (arg1, n) )
-    PROTO_T ( exp arg1 X int n )
+TDFcallop4(exp arg1, int n)
+{
 	/* construct proc call for unary op corresponding to n */
-	char * nm = fn_of_op(n, is_signed(sh(arg1)));
+	char *nm = fn_of_op(n, is_signed(sh(arg1)));
 	exp dc;
 	exp ob;
 	exp_list pars;
 	exp_option novar;
 	exp res;
 	dc = find_named_tg(nm, f_proc);
 	ob = me_obtain(dc);
 	pars.number = 1;
 	pars.start = arg1;
 	pars.end = arg1;
 	res = f_apply_proc(sh(arg1), ob, pars, novar);
 	return res;
 }
-#endif
+#endif /* !has64bits */
 error_treatment f_wrap;
 error_treatment f_impossible;
 error_treatment f_continue;
 #ifdef promote_pars
-static void promote_actuals
+static void
-    PROTO_N ( (par) )
-    PROTO_T ( exp par )
+promote_actuals(exp par)
+{
-    for(;;) {
+	for (;;) {
-	shape s = sh(par);
+		shape s = sh(par);
-	if (name(s)>=scharhd && name(s)<=uwordhd) {
+		if (name(s) >= scharhd && name(s) <= uwordhd) {
-	    shape ns = (is_signed(s))? slongsh:ulongsh;
+			shape ns = (is_signed(s)) ? slongsh : ulongsh;
-	    exp w = hold_check(f_change_variety(f_wrap,ns, copy(par)));
+			exp w = hold_check(f_change_variety(f_wrap, ns,
-	    replace(par, w, nilexp);
-	    kill_exp(par, nilexp);
-	    par = w;
-	}
-	if (last(par)) break;
-	par = bro(par);
+							    copy(par)));
-    }
-}
-static void promote_formals
-    PROTO_N ( (bdy) )
-    PROTO_T ( exp bdy )
-{
-	while ((name(bdy) == ident_tag && isparam(bdy))
-#ifndef NEWDIAGS
-		|| name(bdy) == diagnose_tag
-#endif
-		) {
-	    shape spar = sh(son(bdy));
-	    if (name(bdy)!=ident_tag) { bdy = son(bdy); continue; }
-	    if (name(spar)>=scharhd && name(spar)<= uwordhd) {
-		shape ns = (is_signed(spar))? slongsh: ulongsh;
-		exp u = pt(bdy);
-		exp w;
-		sh(son(bdy)) = ns;
-		if (!isvar(bdy)) {
-		    while (u != nilexp) {
-			exp nextu = pt(u);
-			sh(u) = ns;
-		    	w = f_change_variety(f_wrap, spar, copy(u));
-			replace(u, w, nilexp);
+			replace(par, w, nilexp);
-			kill_exp(u, nilexp);
+			kill_exp(par, nilexp);
-			u = nextu;
+			par = w;
-		    }
 		}
-		else {
-		   shape ps = f_pointer(f_alignment(ns));
-		   while (u != nilexp) {
-			exp nextu = pt(u);
-			if (last(u) && name(bro(u)) == cont_tag) {
-			   if (little_end) {
+		if (last(par)) {
-				exp con = bro(u);
-			        sh(u) = ps;
-				sh(con) = ns;
-				w = f_change_variety(f_wrap, spar, copy(con));
-				replace(con, w, nilexp);
-				kill_exp(con,nilexp);
-			   }
-			}
-			else {
+			break;
-				setvis(bdy);
-				if (!little_end) {
-				   sh(u) = ps;
-				   no(u) = shape_size(ns)-shape_size(spar);
-				}
-			}
-			u = nextu;
-		   }
+		}
-	     }
-	     bdy = bro(son(bdy));
+		par = bro(par);
+	}
+}
-#endif
+static void
+promote_formals(exp bdy)
+{
+	while ((name(bdy) == ident_tag && isparam(bdy))
+#ifndef NEWDIAGS
+	       || name(bdy) == diagnose_tag
+#endif
+	      ) {
+		shape spar = sh(son(bdy));
+		if (name(bdy) != ident_tag) {
+			bdy = son(bdy);
+			continue;
+		}
+		if (name(spar) >= scharhd && name(spar) <= uwordhd) {
+			shape ns = (is_signed(spar)) ? slongsh : ulongsh;
+			exp u = pt(bdy);
+			exp w;
+			sh(son(bdy)) = ns;
+			if (!isvar(bdy)) {
+				while (u != nilexp) {
+					exp nextu = pt(u);
+					sh(u) = ns;
+					w = f_change_variety(f_wrap, spar,
+							     copy(u));
+					replace(u, w, nilexp);
+					kill_exp(u, nilexp);
+					u = nextu;
+				}
+			} else {
+				shape ps = f_pointer(f_alignment(ns));
+				while (u != nilexp) {
+					exp nextu = pt(u);
+					if (last(u) && name(bro(u)) == cont_tag) {
+						if (little_end) {
+							exp con = bro(u);
+							sh(u) = ps;
+							sh(con) = ns;
+							w = f_change_variety(
+							    f_wrap, spar,
+							    copy(con));
+							replace(con, w, nilexp);
+							kill_exp(con, nilexp);
+						}
+					} else {
+						setvis(bdy);
+						if (!little_end) {
+							sh(u) = ps;
+							no(u) = shape_size(ns) -
+							    shape_size(spar);
+						}
+					}
+					u = nextu;
+				}
+			}
+		}
+		bdy = bro(son(bdy));
+	}
+}
+#endif /* promote_pars */
 aldef frame_als[32];
 alignment f_locals_alignment = &frame_als[0];
 alignment nv_callers_alignment = &frame_als[1];
 alignment var_callers_alignment = &frame_als[3];
 alignment nv_callees_alignment = &frame_als[7];
 alignment var_callees_alignment = &frame_als[15];
-void init_frame_als
+void
-    PROTO_Z ()
+init_frame_als(void)
 {
-   int i;
+	int i;
-   for(i=0; i<32; i++) {
+	for (i = 0; i < 32; i++) {
-	frame_als[i].al.sh_hd = 0;
+		frame_als[i].al.sh_hd = 0;
-   	frame_als[i].al.al_n = 1;
+		frame_als[i].al.al_n = 1;
-   	frame_als[i].al.al_val.al = 64;
+		frame_als[i].al.al_val.al = 64;
-   	frame_als[i].al.al_val.al_frame = i+1;
+		frame_als[i].al.al_val.al_frame = i + 1;
-   }
+	}
 }
-error_treatment f_trap
+error_treatment
-    PROTO_N ( (ec) )
-    PROTO_T ( error_code_list ec )
+f_trap(error_code_list ec)
 {
-  error_treatment res;
+	error_treatment res;
-  res.err_code = ec;
+	res.err_code = ec;
-  return res;
+	return res;
+}
+alignment
+f_callers_alignment(bool var)
+{
+	return ((var) ? var_callers_alignment : nv_callers_alignment);
+}
+alignment
+f_callees_alignment(bool var)
+{
+	return ((var) ? var_callees_alignment : nv_callees_alignment);
+}
-alignment f_callers_alignment
-    PROTO_N ( (var) )
-    PROTO_T ( bool var )
-{
-    return ((var)?var_callers_alignment:nv_callers_alignment);
-}
-alignment f_callees_alignment
-    PROTO_N ( (var) )
-    PROTO_T ( bool var )
-{
-    return ((var)?var_callees_alignment:nv_callees_alignment);
-}
-otagexp f_make_otagexp
+otagexp
-    PROTO_N ( (tagopt, e) )
-    PROTO_T ( tag_option tagopt X exp e )
+f_make_otagexp(tag_option tagopt, exp e)
+{
 	exp init;
-	if (!tagopt.present) return e;
+	if (!tagopt.present) {
+		return e;
+	}
 	e = getexp(sh(e), nilexp, 0, e, nilexp, 0, 0, caller_tag);
 	init = getexp(sh(e), nilexp, 0, nilexp , nilexp, 0, 0, caller_name_tag);
 	pt(e) = getexp(f_top, nilexp, 0, init, nilexp, 0, 0, ident_tag);
-/*  	setvar(pt(e));   - NOT ACCORDING TO SPEC */
+	/*  	setvar(pt(e));   - NOT ACCORDING TO SPEC */
-	setfather(e,son(e));
+	setfather(e, son(e));
 	set_tag(tagopt.val, pt(e));
 	return e;
+}
-otagexp_list new_otagexp_list
+otagexp_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
+new_otagexp_list(int n)
+{
 	otagexp_list res;
 	res.number =0;
 	res.start = nilexp;
 	res.end = nilexp;
 	res.id = nilexp;
-	UNUSED (n);
+	UNUSED(n);
 	return res;
+}
-otagexp_list add_otagexp_list
+otagexp_list
-    PROTO_N ( (list, ote, n) )
-    PROTO_T ( otagexp_list list X otagexp ote X int n )
+add_otagexp_list(otagexp_list list, otagexp ote, int n)
+{
 	if (list.number++ == 0) {
-	  	list.start = list.end = ote;
+		list.start = list.end = ote;
-	}
-	else {
+	} else {
 		bro(list.end) = ote;
 		clearlast(list.end);
 		list.end = ote;
+	}
 	setlast(ote);
-	if (name(ote)== caller_tag) {
+	if (name(ote) == caller_tag) {
 		exp id = pt(ote);
 		exp lid = list.id;
 		bro(son(id)) = lid;
 		if (lid != nilexp) {
-			bro(lid) = id; setlast(lid);
+			bro(lid) = id;
+			setlast(lid);
+		}
 		no(son(id)) = n;
 		list.id = id;
 		pt(ote) = nilexp; /* this pt is a temp link */
+	}
 	return list;
 }
-callees f_make_callee_list
+callees
-    PROTO_N ( (args) )
-    PROTO_T ( exp_list args )
+f_make_callee_list(exp_list args)
+{
-	exp e = getexp(f_top, nilexp, 0, args.start, nilexp, 0,
+	exp e = getexp(f_top, nilexp, 0, args.start, nilexp, 0, args.number,
-			args.number, make_callee_list_tag);
+		       make_callee_list_tag);
-	if(args.number!=0) {
+	if (args.number != 0) {
-		 setfather(e,args.end);
+		setfather(e, args.end);
 #ifdef promote_pars
 		promote_actuals(args.start);
 #endif
-	 }
+	}
 	return e;
+}
-callees f_make_dynamic_callees
+callees
-    PROTO_N ( (ptr,sze) )
-    PROTO_T ( exp ptr X exp sze )
+f_make_dynamic_callees(exp ptr, exp sze)
+{
 	exp e = getexp(f_top, nilexp, 0, ptr, nilexp, 0, 0,
-				make_dynamic_callee_tag);
+		       make_dynamic_callee_tag);
-	bro(ptr) = sze; clearlast(ptr);
+	bro(ptr) = sze;
+	clearlast(ptr);
 	setfather(e, sze);
 	return e;
 }
-  /* exps waiting to be used have the parked flag set in props,
+/* exps waiting to be used have the parked flag set in props,
-     so that used_in need not look at their context.
+   so that used_in need not look at their context.
-     This procedure removes the parked flag from each member of an
+   This procedure removes the parked flag from each member of an
-     exp list, in preparation for putting them into their
+   exp list, in preparation for putting them into their
-     proper context.
+   proper context.
-  */
+ */
-void clear_exp_list
+void
-    PROTO_N ( (el) )
-    PROTO_T ( exp_list el )
+clear_exp_list(exp_list el)
 {
-  exp t = el.start;
+	exp t = el.start;
-  if (t == nilexp)
+	if (t == nilexp) {
-    return;
+		return;
+	}
-  while (1)
+	while (1) {
-   {
-     parked(t) = 0;
+		parked(t) = 0;
-     if (t == el.end)
+		if (t == el.end) {
-       return;
+			return;
+		}
-     t = bro(t);
+		t = bro(t);
-   };
+	}
 }
 alignment frame_alignment;
-  /* ntest codes */
+/* ntest codes */
 ntest f_equal = 5;
 ntest f_greater_than = 1;
 ntest f_greater_than_or_equal = 2;
 ntest f_less_than = 3;
 ntest f_less_than_or_equal = 4;
 ntest f_not_comparable = 14;
 static ntest convert_ntest[] = {0, 1, 2, 3, 4, 5, 6,
 , 2, 3, 4, 6, 5, 13, 14};
-static exp replace_ntest
+static exp
-    PROTO_N ( (nt, dest, arg1, arg2) )
-    PROTO_T ( ntest nt X label dest X exp arg1 X exp arg2 )
+replace_ntest(ntest nt, label dest, exp arg1, exp arg2)
 {
-  exp res;
+	exp res;
-  exp_list el;
+	exp_list el;
-  el = new_exp_list(2);
+	el = new_exp_list(2);
-  el = add_exp_list(el, arg1, 0);
+	el = add_exp_list(el, arg1, 0);
-  el = add_exp_list(el, arg2, 1);
+	el = add_exp_list(el, arg2, 1);
-  if (nt == f_comparable)
+	if (nt == f_comparable) {
-    res = f_make_top();
+		res = f_make_top();
-  else
+	} else {
-    res = f_goto(dest);
+		res = f_goto(dest);
+	}
-  return f_sequence(el, res);
+	return f_sequence(el, res);
 }
-  /* rounding mode codes */
+/* rounding mode codes */
 rounding_mode f_to_nearest = R2NEAR;
 rounding_mode f_toward_larger = R2PINF;
 rounding_mode f_toward_smaller = R2NINF;
 rounding_mode f_toward_zero = R2ZERO;
 rounding_mode f_round_as_state = 4;
 transfer_mode f_standard_transfer_mode = 0;
 transfer_mode f_volatile = 1;
 transfer_mode f_overlap = 2;
 transfer_mode f_complete = 4;
-#define max(x,y) ((x)>(y)) ? (x) : (y)
+#define max(x, y)	((x) > (y)) ? (x) : (y)
-   /* careful: use simple arguments! */
+/* careful: use simple arguments! */
-alignment f_alignment
+alignment
-    PROTO_N ( (sha) )
-    PROTO_T ( shape sha )
+f_alignment(shape sha)
 {
-  return align_of(sha);
+	return align_of(sha);
 }
   /* we may not yet know the actual values for the alignments,
      merely that they are computed from other alignments by unite.
      So we have to set up equations which are solved at the end of aldefs
   */
-alignment f_obtain_al_tag
+alignment
-    PROTO_N ( (a1) )
-    PROTO_T ( al_tag a1 )
+f_obtain_al_tag(al_tag a1)
 {
-  alignment j;
+	alignment j;
-  if (a1->al.al_n == 1)
+	if (a1->al.al_n == 1) {
-      return long_to_al(a1->al.al_val.al);
+		return long_to_al(a1->al.al_val.al);
+	}
-  j = (alignment)calloc(1, sizeof(aldef));
+	j = (alignment)calloc(1, sizeof(aldef));
-  j -> al.al_n = 3;
+	j->al.al_n = 3;
-  j -> al.al_val.al_join.a = a1;
+	j->al.al_val.al_join.a = a1;
-  j -> next_aldef = top_aldef;
+	j->next_aldef = top_aldef;
-  top_aldef = j;
+	top_aldef = j;
-  return j;
+	return j;
 }
-alignment f_unite_alignments
+alignment
-    PROTO_N ( (a1, a2) )
-    PROTO_T ( alignment a1 X alignment a2 )
+f_unite_alignments(alignment a1, alignment a2)
 {
-  alignment j;
+	alignment j;
-  if (a1->al.al_n == 1 && a2->al.al_n == 1)
+	if (a1->al.al_n == 1 && a2->al.al_n == 1) {
-   {
-    if (a1->al.al_val.al_frame == a2->al.al_val.al_frame) {
+		if (a1->al.al_val.al_frame == a2->al.al_val.al_frame) {
-    	if (a1->al.al_val.al > a2->al.al_val.al)
+			if (a1->al.al_val.al > a2->al.al_val.al) {
-      	{ return a1; }
+				return a1;
-    	else
+			} else {
-      	{ return a2; }
+				return a2;
-    }
+			}
-    else
-    if (a1->al.al_val.al_frame ==0) { return a2; }
+		} else if (a1->al.al_val.al_frame ==0) {
-    else
+			return a2;
-    if (a2->al.al_val.al_frame == 0) { return a1; }
+		} else if (a2->al.al_val.al_frame == 0) {
+			return a1;
-    else {
+		} else {
-    	return (&frame_als[(a1->al.al_val.al_frame | a2->al.al_val.al_frame)-1]);
+			return (&frame_als[(a1->al.al_val.al_frame |
+					    a2->al.al_val.al_frame) -1]);
-    }
+		}
+	}
-   };
-  j = (alignment)calloc(1, sizeof(aldef));
+	j = (alignment)calloc(1, sizeof(aldef));
-  j -> al.al_n = 2;
+	j->al.al_n = 2;
-  j -> al.al_val.al_join.a = a1;
+	j->al.al_val.al_join.a = a1;
-  j -> al.al_val.al_join.b = a2;
+	j->al.al_val.al_join.b = a2;
-  j -> next_aldef = top_aldef;
+	j->next_aldef = top_aldef;
-  top_aldef = j;
+	top_aldef = j;
-  return j;
+	return j;
 }
+void
-void init_access
+init_access(void)
-    PROTO_Z ()
 {
-  return;
+	return;
 }
-access f_dummy_access;
+access f_dummy_access;
 access f_visible = 1;
 access f_standard_access = 0;
 access f_long_jump_access = 2;
 access f_constant = 4;
 access f_no_other_write = 16;
 access f_register = 32;
 access f_out_par = 64;
 access f_used_as_volatile = 128;
 access f_preserve = 256;
-access f_add_accesses
+access
-    PROTO_N ( (a1, a2) )
-    PROTO_T ( access a1 X access a2 )
+f_add_accesses(access a1, access a2)
 {
-  return a1 | a2;
+	return a1 | a2;
+}
 alignment f_alloca_alignment;
 alignment f_var_param_alignment;
 alignment f_code_alignment;
-static struct CAL { short sh_hd; short al; alignment res; struct CAL * rest;}*
+static struct CAL {
+	short sh_hd;
+	short al;
+	alignment res;
+	struct CAL *rest;
-		cache_pals;
+} *cache_pals;
+void
-void init_alignment
+init_alignment(void)
-    PROTO_Z ()
+{
-  const_al1->al.al_n = 1;
+	const_al1->al.al_n = 1;
-  const_al1->al.al_val.al = 1;
+	const_al1->al.al_val.al = 1;
-  const_al1->al.al_val.al_frame = 0;
+	const_al1->al.al_val.al_frame = 0;
-  const_al1->al.sh_hd = 0;
+	const_al1->al.sh_hd = 0;
-  const_al8->al.al_n = 1;
+	const_al8->al.al_n = 1;
-  const_al8->al.al_val.al = 8;
+	const_al8->al.al_val.al = 8;
-  const_al8->al.al_val.al_frame = 0;
+	const_al8->al.al_val.al_frame = 0;
-  const_al8->al.sh_hd = 0;
+	const_al8->al.sh_hd = 0;
-  const_al16->al.al_n = 1;
+	const_al16->al.al_n = 1;
-  const_al16->al.al_val.al = 16;
+	const_al16->al.al_val.al = 16;
-  const_al16->al.al_val.al_frame = 0;
+	const_al16->al.al_val.al_frame = 0;
-  const_al16->al.sh_hd = 0;
+	const_al16->al.sh_hd = 0;
-  const_al32->al.al_n = 1;
+	const_al32->al.al_n = 1;
-  const_al32->al.al_val.al = 32;
+	const_al32->al.al_val.al = 32;
-  const_al32->al.al_val.al_frame = 0;
+	const_al32->al.al_val.al_frame = 0;
-  const_al32->al.sh_hd = 0;
+	const_al32->al.sh_hd = 0;
-  const_al64->al.al_n = 1;
+	const_al64->al.al_n = 1;
-  const_al64->al.al_val.al = 64;
+	const_al64->al.al_val.al = 64;
-  const_al64->al.al_val.al_frame = 0;
+	const_al64->al.al_val.al_frame = 0;
-  const_al64->al.sh_hd = 0;
+	const_al64->al.sh_hd = 0;
-  const_al512->al.al_n = 1;
+	const_al512->al.al_n = 1;
-  const_al512->al.al_val.al = 512;
+	const_al512->al.al_val.al = 512;
-  const_al512->al.al_val.al_frame = 0;
+	const_al512->al.al_val.al_frame = 0;
-  const_al512->al.sh_hd = 0;
+	const_al512->al.sh_hd = 0;
+	cache_pals = (struct CAL *)0;
+	init_frame_als();
+	f_alloca_alignment = ALLOCA_ALIGN;
+	f_var_param_alignment = VAR_PARAM_ALIGN;
+	f_code_alignment = CODE_ALIGN;
+	stack_align = max(param_align, double_align);
+	return;
+}
-  cache_pals = (struct CAL *)0;
-  init_frame_als();
-  f_alloca_alignment = ALLOCA_ALIGN;
-  f_var_param_alignment = VAR_PARAM_ALIGN;
-  f_code_alignment = CODE_ALIGN;
-  stack_align = max(param_align, double_align);
-  return;
-}
 alignment f_dummy_alignment;
-static alignment get_pal
+static alignment
-    PROTO_N ( (a, sh_hd, al) )
-    PROTO_T ( alignment a X int sh_hd X int al )
+get_pal(alignment a, int sh_hd, int al)
+{
-	struct CAL * c = cache_pals;
+	struct CAL *c = cache_pals;
 	alignment res;
-	while (c != (struct CAL*)0) {
+	while (c != (struct CAL *)0) {
-		if (c->sh_hd == sh_hd && c->al == al) return c->res;
+		if (c->sh_hd == sh_hd && c->al == al) {
+			return c->res;
+		}
 		c = c->rest;
+	}
 	res = (alignment)xmalloc(sizeof(aldef));
 	*res = *a;
-	res -> al.sh_hd = sh_hd;
+	res->al.sh_hd = sh_hd;
-	c = (struct CAL*)xmalloc(sizeof(struct CAL));
+	c = (struct CAL *)xmalloc(sizeof(struct CAL));
+	c->sh_hd = sh_hd;
+	c->al = al;
+	c->res = res;
-	c->sh_hd = sh_hd; c->al = al; c->res = res; c->rest = cache_pals;
+	c->rest = cache_pals;
 	cache_pals = c;
 	return res;
 }
-alignment f_parameter_alignment
+alignment
-    PROTO_N ( (sha) )
-    PROTO_T ( shape sha )
+f_parameter_alignment(shape sha)
 {
 	int n = name(sha);
 	alignment t =
 #if issparc
-	  MIN_PAR_ALIGNMENT;
+	    MIN_PAR_ALIGNMENT;
 #else
-          f_unite_alignments(MIN_PAR_ALIGNMENT, f_alignment(sha));
+	f_unite_alignments(MIN_PAR_ALIGNMENT, f_alignment(sha));
 #endif
 #if ishppa
-	if (shape_size(sha) > 64)
+	if (shape_size(sha) > 64) {
-		n = nofhd+1;
+		n = nofhd + 1;
+	}
 #endif
 #if issparc
-	if (sparccpd(sha))
+	if (sparccpd(sha)) {
-		n = nofhd+1;
+		n = nofhd + 1;
+	}
 #endif
-	return get_pal(t,n,shape_align(sha));
+	return get_pal(t, n, shape_align(sha));
+}
+bitfield_variety
+f_bfvar_bits(bool issigned, nat bits)
+{
-bitfield_variety f_bfvar_bits
+	bitfield_variety res;
-    PROTO_N ( (issigned, bits) )
+	if (!nat_issmall(bits)) {
+		failer(TOO_MANY_BITS);
+	}
+	res.has_sign = issigned;
+	res.bits = natint(bits);
-    PROTO_T ( bool issigned X nat bits )
+	if (extra_checks && res.bits > SLONG_SZ) {
+		failer(TOO_MANY_BITS);
+	}
+	return res;
+}
+void
+init_bitfield_variety(void)
+{
-  bitfield_variety res;
-  if (!nat_issmall(bits))
-   failer(TOO_MANY_BITS);
-  res.has_sign = issigned;
-  res.bits = natint(bits);
-  if (extra_checks && res.bits > SLONG_SZ)
-   failer(TOO_MANY_BITS);
-  return res;
+	return;
 }
-void init_bitfield_variety
-    PROTO_Z ()
-{
-  return;
-}
 bitfield_variety f_dummy_bitfield_variety;
 bool f_false = 0;
 bool f_true = 1;
-void init_bool
-    PROTO_Z ()
-{
-  return;
-}
+void
-bool f_dummy_bool;
+init_bool(void)
-caselim f_make_caselim
-    PROTO_N ( (branch, lower, upper) )
-    PROTO_T ( label branch X signed_nat lower X signed_nat upper )
+{
-  caselim c;
-  c.lab = branch;
-  c.low = lower;
-  c.high = upper;
-  return c;
+	return;
+}
+bool f_dummy_bool;
+caselim
+f_make_caselim(label branch, signed_nat lower, signed_nat upper)
+{
+	caselim c;
+	c.lab = branch;
+	c.low = lower;
+	c.high = upper;
+	return c;
+}
 callees f_dummy_callees;
 callees f_same_callees;
-void init_callees
+void
-    PROTO_Z ()
+init_callees(void)
+{
 	f_same_callees = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0,
-			same_callees_tag);
+				same_callees_tag);
 	return;
 }
-void init_caselim
+void
-    PROTO_Z ()
+init_caselim(void)
 {
-  return;
+	return;
 }
-error_treatment f_error_jump
+error_treatment
-    PROTO_N ( (lab) )
-    PROTO_T ( label lab )
+f_error_jump(label lab)
 {
-  error_treatment e;
+	error_treatment e;
-  e.err_code = 4;
+	e.err_code = 4;
-  e.jmp_dest = lab;
+	e.jmp_dest = lab;
-  return e;
+	return e;
 }
 error_code f_dummy_error_code;
+void
-void init_error_code
+init_error_code(void)
+{
+	return;
+}
+void
-    PROTO_Z ()
+init_error_treatment(void)
+{
+	f_wrap.err_code = 1;
+	f_impossible.err_code = 0;
+	f_continue.err_code = 2;
 	return;
+}
-void init_error_treatment
-    PROTO_Z ()
-{
-  f_wrap.err_code = 1;
-  f_impossible.err_code = 0;
-  f_continue.err_code = 2;
-  return;
-}
 error_treatment f_dummy_error_treatment;
-exp f_abs
+exp
-    PROTO_N ( (ov_err, arg1) )
-    PROTO_T ( error_treatment ov_err X exp arg1 )
+f_abs(error_treatment ov_err, exp arg1)
 {
-  if (name(sh(arg1)) == bothd || !is_signed(sh(arg1)) )
+	if (name(sh(arg1)) == bothd || !is_signed(sh(arg1))) {
-    return arg1;
+		return arg1;
-#if check_shape
-  if (!is_integer(sh(arg1)))
-    failer(CHSH_ABS);
-#endif
-#if !has64bits
-	if (name(sh(arg1)) >= s64hd &&
-		(name(arg1)!=val_tag || ov_err.err_code > 2)) {
-		return TDFcallop1(ov_err,arg1,abs_tag);
+	}
-#endif
-  return me_u1(ov_err, arg1, abs_tag);
-}
-exp f_add_to_ptr
-    PROTO_N ( (arg1, arg2) )
-    PROTO_T ( 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 (!doing_aldefs &&
-	(name(sh(arg1)) != ptrhd || name(sh(arg2)) != offsethd ||
-        (al1(sh(arg1)) < al1(sh(arg2))
-#if issparc
-		&& al1_of(sh(arg2)) != REAL_ALIGN
-#endif
-	) ))
-     failer(CHSH_ADDPTR);
-#endif
-#if issparc || ishppa
-if ((al1_of(sh(arg2))->al.al_val.al_frame & 6) != 0 &&
-#else
-if ((al1_of(sh(arg2))->al.al_val.al_frame &4) != 0 &&
-#endif
-	al2_of(sh(arg2))->al.sh_hd > nofhd) {
-	/* indirect varargs param */
-	exp z = me_b3(f_pointer(f_alignment(sh(arg1))), arg1, arg2, addptr_tag);
-	return f_contents(sh(arg1), z);
-}
-  return(me_b3(f_pointer(al2_of(sh(arg2))), arg1, arg2,
-               addptr_tag));
-}
-exp f_and
-    PROTO_N ( (arg1, arg2) )
-    PROTO_T ( 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 (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1)))
+	if (!is_integer(sh(arg1))) {
-    failer(CHSH_AND);
+		failer(CHSH_ABS);
+	}
 #endif
 #if !has64bits
 	if (name(sh(arg1)) >= s64hd &&
-		(name(arg1)!=val_tag || name(arg2) != val_tag)){
+	    (name(arg1) != val_tag || ov_err.err_code > 2)) {
-		return TDFcallop3(arg1,arg2,and_tag);
+		return TDFcallop1(ov_err, arg1, abs_tag);
+	}
+#endif
+	return me_u1(ov_err, arg1, abs_tag);
+}
+exp
+f_add_to_ptr(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 (!doing_aldefs && (name(sh(arg1)) != ptrhd ||
+			      name(sh(arg2)) != offsethd ||
+			      (al1(sh(arg1)) < al1(sh(arg2))
+#if issparc
+			       && al1_of(sh(arg2)) != REAL_ALIGN
+#endif
+			       ))) {
+		failer(CHSH_ADDPTR);
+	}
 #endif
+#if issparc || ishppa
+	if ((al1_of(sh(arg2))->al.al_val.al_frame & 6) != 0 &&
+#else
+	if ((al1_of(sh(arg2))->al.al_val.al_frame & 4) != 0 &&
+#endif
+	    al2_of(sh(arg2))->al.sh_hd > nofhd) {
+		/* indirect varargs param */
+		exp z = me_b3(f_pointer(f_alignment(sh(arg1))), arg1, arg2,
+			      addptr_tag);
+		return f_contents(sh(arg1), z);
+	}
+	return (me_b3(f_pointer(al2_of(sh(arg2))), arg1, arg2, addptr_tag));
+}
+exp
+f_and(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 (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1))) {
+		failer(CHSH_AND);
+	}
+#endif
+#if !has64bits
+	if (name(sh(arg1)) >= s64hd &&
+	    (name(arg1) != val_tag || name(arg2) != val_tag)) {
+		return TDFcallop3(arg1, arg2, and_tag);
+	}
+#endif
-  return me_b2( arg1, arg2, and_tag);
+	return me_b2(arg1, arg2, and_tag);
+}
-exp f_apply_proc
+exp
-    PROTO_N ( (result_shape, arg1, arg2, varparam) )
-    PROTO_T ( shape result_shape X exp arg1 X exp_list arg2 X exp_option varparam )
+f_apply_proc(shape result_shape, exp arg1, exp_list arg2, exp_option varparam)
+{
-  exp res = getexp(result_shape, nilexp, 0, arg1, nilexp,
+	exp res = getexp(result_shape, nilexp, 0, arg1, nilexp, 0, 0,
-, 0, apply_tag);
+			 apply_tag);
-  int varhack = 0;
+	int varhack = 0;
-  if (name(sh(arg1)) == bothd)
+	if (name(sh(arg1)) == bothd) {
-    return arg1;
+		return arg1;
+	}
 #if check_shape
-  if (name(sh(arg1)) != prokhd)
+	if (name(sh(arg1)) != prokhd) {
-    failer(CHSH_APPLY);
+		failer(CHSH_APPLY);
+	}
 #endif
-  if (varparam.present) {
+	if (varparam.present) {
-   	 /* add a declaration for variable parameters */
+		/* add a declaration for variable parameters */
-     arg2 = add_exp_list(arg2, varparam.val, arg2.number+1);
+		arg2 = add_exp_list(arg2, varparam.val, arg2.number + 1);
-     varhack =1;
+		varhack =1;
-  }
+	}
-  clear_exp_list(arg2);
+	clear_exp_list(arg2);
-  if (name(arg1) == name_tag && isglob(son(arg1)) &&
-             !isvar(son(arg1)))
-    {speci sp;
-       /* check for substitutions for certain global procedures */
-     sp = special_fn(arg1, arg2.start, result_shape);
-     if (sp.is_special)
-       return sp.special_exp;
-    };
+	if (name(arg1) == name_tag && isglob(son(arg1)) && !isvar(son(arg1))) {
+		speci sp;
+		/* check for substitutions for certain global procedures */
+		sp = special_fn(arg1, arg2.start, result_shape);
+		if (sp.is_special) {
+			return sp.special_exp;
+		}
+	}
-  if (arg2.number==0)
+	if (arg2.number==0) {
-     {setfather(res, arg1);}
+		setfather(res, arg1);
-  else
+	} else {
-   {
-     clearlast(arg1);
+		clearlast(arg1);
-     bro(arg1) = arg2.start;
+		bro(arg1) = arg2.start;
-     setfather(res, arg2.end);
+		setfather(res, arg2.end);
 #ifdef promote_pars
-    promote_actuals(bro(son(res)));
+		promote_actuals(bro(son(res)));
 #endif
-   };
+	}
-  /* rewrite struct/union value parameters as pointer-to-copy */
+	/* rewrite struct/union value parameters as pointer-to-copy */
-  if (redo_structparams && arg2.number > 0)       /* has >0 params */
+	if (redo_structparams && arg2.number > 0) {
-  {
-    exp param, prev;
+		/* has >0 params */
-    prev = arg1;
-    param = bro(arg1);
+		exp param, prev;
+		prev = arg1;
+		param = bro(arg1);
-    while (1 /*"break" below*/)
+		while (1 /*"break" below*/) {
-    {
-      if ((varhack && last(param)) ||
+			if ((varhack && last(param)) ||
 #if ishppa
+exp
-  return me_b3( f_top, arg1, arg2, ass_tag);
+f_assign(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;
-}
+	}
-exp f_assign_with_mode
-    PROTO_N ( (md, arg1, arg2) )
+	return me_b3(f_top, arg1, arg2, ass_tag);
+}
+exp
-    PROTO_T ( transfer_mode md X exp arg1 X exp arg2 )
+f_assign_with_mode(transfer_mode md, 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 (md & f_complete) {
+	if (md & f_complete) {
-	exp d = me_startid(f_top, arg2, 0);
+		exp d = me_startid(f_top, arg2, 0);
-	return me_complete_id(d,
+		return me_complete_id(d, f_assign_with_mode(md & ~f_complete,
+							    arg1,
-		f_assign_with_mode(md & ~f_complete,arg1, me_obtain(d)) );
+							    me_obtain(d)));
-  }
+	}
 #ifdef no_trap_on_nil_contents
-  if ((md & f_trap_on_nil) != 0) {
+	if ((md & f_trap_on_nil) != 0) {
-    exp d = me_startid(f_top, arg1, 0);
+		exp d = me_startid(f_top, 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_list el;
 		exp test = me_q1(no_nat_option, f_equal, &lb, me_obtain(d),
-				f_make_null_ptr(al1_of(sh(arg1))), test_tag);
+				 f_make_null_ptr(al1_of(sh(arg1))), test_tag);
-		exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp,
+		exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,
-, f_nil_access, trap_tag);
+				 f_nil_access, trap_tag);
 		md &= ~f_trap_on_nil;
-     		el = new_exp_list(1);
+		el = new_exp_list(1);
-     		el = add_exp_list(el, test, 1);
+		el = add_exp_list(el, test, 1);
-     		return me_complete_id(d,
+		return me_complete_id(d, f_conditional(&lb, f_sequence(el, trp),
-		   f_conditional(&lb, f_sequence(el, trp),
+						       f_assign_with_mode(md,
-				f_assign_with_mode(md, me_obtain(d), arg2)) );
+						       me_obtain(d), arg2)));
-   	};
+	}
 #endif
-  if ((md & f_volatile)!=0)
+	if ((md & f_volatile) != 0) {
-    return me_b3(f_top, arg1, arg2, assvol_tag);
+		return me_b3(f_top, arg1, arg2, assvol_tag);
-  else
-  if ( (md & f_overlap) &&
+	} else if ((md & f_overlap) &&
-	(name(arg2) == cont_tag || name(arg2) == contvol_tag) &&
+		   (name(arg2) == cont_tag || name(arg2) == contvol_tag) &&
-	! reg_result(sh(arg2)) )
+		   !reg_result(sh(arg2))) {
-    return f_move_some(md, son(arg2), arg1,f_shape_offset(sh(arg2)));
+		return f_move_some(md, son(arg2), arg1,
+				   f_shape_offset(sh(arg2)));
+	} else {
-  else return me_b3(f_top, arg1, arg2, ass_tag);
+		return me_b3(f_top, arg1, arg2, ass_tag);
+	}
+}
-exp f_bitfield_assign
+exp
-    PROTO_N ( (p, off, val) )
-    PROTO_T ( exp p X exp off X exp val )
+f_bitfield_assign(exp p, exp off, exp val)
+{
-  exp res;
+	exp res;
-  if (name(sh(p)) == bothd)
+	if (name(sh(p)) == bothd) {
-    return p;
+		return p;
+	}
-  if (name(sh(val)) == bothd)
+	if (name(sh(val)) == bothd) {
-    return val;
+		return val;
+	}
 #if check_shape
-  if (name(sh(p)) != ptrhd || name(sh(off)) != offsethd )
+	if (name(sh(p)) != ptrhd || name(sh(off)) != offsethd) {
-    failer(CHSH_BFASS);
+		failer(CHSH_BFASS);
+	}
 #endif
-  if (name(off) == val_tag) {
+	if (name(off) == val_tag) {
-  	res = me_b3(f_top, p, val, bfass_tag);
+		res = me_b3(f_top, p, val, bfass_tag);
-  	no(res) = no(off);
+		no(res) = no(off);
-  	return res;
+		return res;
-  }
-  else {
+	} else {
-	int alofptr = al1(sh(p));
+		int alofptr = al1(sh(p));
-	shape s = containedshape(alofptr, 0);
+		shape s = containedshape(alofptr, 0);
-	shape bfs = sh(val);
+		shape bfs = sh(val);
-	int nbits = shape_size(sh(val));
+		int nbits = shape_size(sh(val));
-	alignment als = f_alignment(s);
+		alignment als = f_alignment(s);
-        alignment alb = long_to_al(1);
+		alignment alb = long_to_al(1);
-	shape os = f_offset(als,als);
+		shape os = f_offset(als, als);
-	shape bos = f_offset(alb,alb);
+		shape bos = f_offset(alb, alb);
-        exp mask0 = getexp(s, nilexp, 0, nilexp, nilexp, 0,
+		exp mask0 = getexp(s, nilexp, 0, nilexp, nilexp, 0,
-			((1 << nbits)-1), val_tag);
+				   ((1 << nbits) -1), val_tag);
-	exp noff1 = getexp(sh(off), nilexp, 0, nilexp, nilexp, 0, 0,
+		exp noff1 = getexp(sh(off), nilexp, 0, nilexp, nilexp, 0, 0,
-			name_tag);
+				   name_tag);
-	exp noff2 = getexp(sh(off), nilexp, 0, nilexp, noff1, 0, 0,
+		exp noff2 = getexp(sh(off), nilexp, 0, nilexp, noff1, 0, 0,
-			name_tag);
+				   name_tag);
-	exp idoff = getexp(f_top, nilexp, 0, off, noff2, 0, 2, ident_tag);
+		exp idoff = getexp(f_top, nilexp, 0, off, noff2, 0, 2,
+				   ident_tag);
-	son(noff1) = idoff; son(noff2) = idoff;
+		son(noff1) = idoff; son(noff2) = idoff;
-      {
+		{
-     	exp addbf = f_offset_add( noff1,f_shape_offset(bfs) );
+			exp addbf = f_offset_add(noff1, f_shape_offset(bfs));
-	exp byteoffinit = f_offset_subtract(hold_check(f_offset_pad(als, addbf)),
+			exp byteoffinit = f_offset_subtract(hold_check(
+					  f_offset_pad(als, addbf)),
-			hold_check(f_offset_pad(als, f_shape_offset(s))) );
+					  hold_check(f_offset_pad(als,
+					  f_shape_offset(s))));
-	exp v1bit = getexp(bos, nilexp, 0, nilexp, nilexp, 0, 1, val_tag);
+			exp v1bit = getexp(bos, nilexp, 0, nilexp, nilexp, 0, 1,
+					   val_tag);
-	exp nby1 = getexp(os, nilexp, 0, nilexp, nilexp, 0, 0, name_tag);
+			exp nby1 = getexp(os, nilexp, 0, nilexp, nilexp, 0, 0,
+					  name_tag);
-	exp nby2 = getexp(os, nilexp, 0, nilexp, nby1, 0, 0, name_tag);
+			exp nby2 = getexp(os, nilexp, 0, nilexp, nby1, 0, 0,
+					  name_tag);
-	exp nby3 = getexp(os, nilexp, 0, nilexp, nby2, 0, 0, name_tag);
+			exp nby3 = getexp(os, nilexp, 0, nilexp, nby2, 0, 0,
+					  name_tag);
-	exp idby = getexp(f_top, idoff, 1, byteoffinit, nby3, 0,
+			exp idby = getexp(f_top, idoff, 1, byteoffinit, nby3, 0,
 , ident_tag);
-        exp bitoffinit = f_offset_div(ulongsh,
+			exp bitoffinit = f_offset_div(ulongsh,
+					 f_offset_subtract(noff2,
-		   f_offset_subtract(noff2,f_offset_pad(f_alignment(bfs), nby2)),
+					 f_offset_pad(f_alignment(bfs), nby2)),
-					v1bit);
+					 v1bit);
-	exp bnt1 = getexp(ulongsh, nilexp,0, nilexp, nilexp, 0,
+			exp bnt1 = getexp(ulongsh, nilexp, 0, nilexp, nilexp, 0,
 , name_tag);
- 	exp bnt2 = getexp(ulongsh, nilexp,0, nilexp, bnt1, 0, 0, name_tag);
+			exp bnt2 = getexp(ulongsh, nilexp, 0, nilexp, bnt1, 0,
+, name_tag);
 #if little_end
-	exp idbnt = getexp(f_top, idby, 1, bitoffinit, bnt2, 0, 2, ident_tag);
+			exp idbnt = getexp(f_top, idby, 1, bitoffinit, bnt2, 0,
+, ident_tag);
 #else
-	exp v = getexp(ulongsh, nilexp, 0, nilexp, nilexp, 0,
+			exp v = getexp(ulongsh, nilexp, 0, nilexp, nilexp, 0,
-				shape_size(s)-nbits, val_tag);
+				       shape_size(s) - nbits, val_tag);
-	exp idbnt = getexp(f_top, idby, 1, f_minus(f_wrap, v, bitoffinit),
+			exp idbnt = getexp(f_top, idby, 1, f_minus(f_wrap, v,
+								   bitoffinit),
-				 bnt2, 0, 2, ident_tag);
+					   bnt2, 0, 2, ident_tag);
 #endif
-	exp pn1 = getexp(sh(p), nilexp,0, nilexp, nilexp, 0, 0, name_tag);
+			exp pn1 = getexp(sh(p), nilexp, 0, nilexp, nilexp, 0, 0,
+					 name_tag);
- 	exp pn2 = getexp(sh(p), nilexp,0, nilexp, pn1, 0, 0, name_tag);
+			exp pn2 = getexp(sh(p), nilexp, 0, nilexp, pn1, 0, 0,
+					 name_tag);
-	exp idpn = getexp(f_top, idbnt, 1, f_add_to_ptr(p, nby1), pn2, 0,
+			exp idpn = getexp(f_top, idbnt, 1,
+					  f_add_to_ptr(p, nby1), pn2, 0, 2,
-, ident_tag);
+					  ident_tag);
-	exp cnt; exp mask1; exp orit; exp asit;
+			exp cnt; exp mask1; exp orit; exp asit;
- 	son(nby1) = idby; son(nby2) = idby; son(nby3) = idby;
+			son(nby1) = idby; son(nby2) = idby; son(nby3) = idby;
-        son(bnt1) = idbnt; son(bnt2) = idbnt;
+			son(bnt1) = idbnt; son(bnt2) = idbnt;
-	son(pn1) = idpn; son(pn2) = idpn;
+			son(pn1) = idpn; son(pn2) = idpn;
-	bro(son(idby)) = idbnt; clearlast(son(idby));
+			bro(son(idby)) = idbnt; clearlast(son(idby));
-	bro(son(idbnt)) = idpn; clearlast(son(idbnt));
+			bro(son(idbnt)) = idpn; clearlast(son(idbnt));
-        bro(son(idoff)) = idby; clearlast(son(idoff));
+			bro(son(idoff)) = idby; clearlast(son(idoff));
-	mask1 = f_not(f_shift_left(f_wrap, mask0, bnt1));
+			mask1 = f_not(f_shift_left(f_wrap, mask0, bnt1));
-	cnt = f_and(f_contents(s, pn1), mask1);
+			cnt = f_and(f_contents(s, pn1), mask1);
-	orit = f_or(cnt, f_shift_left(f_wrap, f_change_bitfield_to_int(s, val),
+			orit = f_or(cnt, f_shift_left(f_wrap,
-					 bnt2));
+			    f_change_bitfield_to_int(s, val), bnt2));
-	asit = f_assign(pn2, orit);
+			asit = f_assign(pn2, orit);
-	bro(son(idpn)) = asit; clearlast(son(idpn));
+			bro(son(idpn)) = asit; clearlast(son(idpn));
-	bro(asit) = idpn; setlast(asit);
+			bro(asit) = idpn; setlast(asit);
-        return idoff;
+			return idoff;
-      }
+		}
-  }
+	}
+}
-}
-exp f_bitfield_assign_with_mode
+exp
-    PROTO_N ( (md, p, off, val) )
-    PROTO_T ( transfer_mode md X exp p X exp off X exp val )
+f_bitfield_assign_with_mode(transfer_mode md, exp p, exp off, exp val)
 {
-  exp res;
+	exp res;
-  if (name(sh(p)) == bothd)
+	if (name(sh(p)) == bothd) {
-    return p;
+		return p;
+	}
-  if (name(sh(val)) == bothd)
+	if (name(sh(val)) == bothd) {
-    return val;
+		return val;
+	}
-  if (md == f_standard_transfer_mode)
+	if (md == f_standard_transfer_mode) {
-    return f_bitfield_assign (p, off, val);
+		return f_bitfield_assign(p, off, val);
+	}
 #if check_shape
-  if (name(sh(p)) != ptrhd || name(sh(off)) != offsethd ||
+	if (name(sh(p)) != ptrhd || name(sh(off)) != offsethd ||
-	name(off) != val_tag)
+	    name(off) != val_tag) {
-    failer(CHSH_BFASS);
+		failer(CHSH_BFASS);
+	}
 #endif
 #ifdef no_trap_on_nil_contents
-  if ((md & f_trap_on_nil) != 0) {
+	if ((md & f_trap_on_nil) != 0) {
 		exp d = me_startid(f_top, p, 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_list el;
 		exp test = me_q1(no_nat_option, f_equal, &lb, me_obtain(d),
-				f_make_null_ptr(al1_of(sh(p))), test_tag);
+				 f_make_null_ptr(al1_of(sh(p))), test_tag);
-		exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp,
+		exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,
-, f_nil_access, trap_tag);
+				 f_nil_access, trap_tag);
 		md &= ~f_trap_on_nil;
-     		el = new_exp_list(1);
+		el = new_exp_list(1);
-     		el = add_exp_list(el, test, 1);
+		el = add_exp_list(el, test, 1);
-     		return me_complete_id(d,
-		   f_conditional(&lb, f_sequence(el, trp),
+		return me_complete_id(d, f_conditional(&lb, f_sequence(el, trp),
-				f_bitfield_assign_with_mode(md, me_obtain(d), off, val)) );
+		    f_bitfield_assign_with_mode(md, me_obtain(d), off, val)));
-   	};
+	}
 #endif
-  if (md & f_volatile)
+	if (md & f_volatile) {
-    res = me_b3(f_top, p, val, bfassvol_tag);
+		res = me_b3(f_top, p, val, bfassvol_tag);
-  else
+	} else {
-    res = me_b3(f_top, p, val, bfass_tag);
+		res = me_b3(f_top, p, val, bfass_tag);
+	}
-  no(res) = no(off);
+	no(res) = no(off);
-  return res;
+	return res;
 }
-exp f_bitfield_contents
+exp
-    PROTO_N ( (bf, p, off) )
-    PROTO_T ( bitfield_variety bf X exp p X exp off )
+f_bitfield_contents(bitfield_variety bf, exp p, exp off)
 {
-  exp res;
+	exp res;
-  if (name(sh(p)) == bothd)
+	if (name(sh(p)) == bothd) {
-    return off;
+		return off;
+	}
-  if (name(sh(off)) == bothd)
+	if (name(sh(off)) == bothd) {
-    return p;
+		return p;
+	}
 #if check_shape
-  if (name(sh(p)) != ptrhd || name(sh(off)) != offsethd )
+	if (name(sh(p)) != ptrhd || name(sh(off)) != offsethd)
-    failer(CHSH_BFCONT);
+		failer(CHSH_BFCONT);
 #endif
-  if (name(off) == val_tag) {
+	if (name(off) == val_tag) {
-  	res = me_u3(f_bitfield(bf), p, bfcont_tag);
+		res = me_u3(f_bitfield(bf), p, bfcont_tag);
-  	no(res) = no(off);
+		no(res) = no(off);
-  	return res;
+		return res;
-  }
-  else {
+	} else {
-	int alofptr = al1(sh(p));
+		int alofptr = al1(sh(p));
-	shape s = containedshape(alofptr, bf.has_sign);
+		shape s = containedshape(alofptr, bf.has_sign);
-	shape bfs = f_bitfield(bf);
+		shape bfs = f_bitfield(bf);
-	alignment als = f_alignment(s);
+		alignment als = f_alignment(s);
-	alignment alb = long_to_al(1);
+		alignment alb = long_to_al(1);
-	shape ob = f_offset(alb,alb);
+		shape ob = f_offset(alb, alb);
-	shape os = f_offset(als,als);
+		shape os = f_offset(als, als);
-	exp noff1 = getexp(sh(off), nilexp, 0, nilexp, nilexp, 0, 0,
+		exp noff1 = getexp(sh(off), nilexp, 0, nilexp, nilexp, 0, 0,
-			name_tag);
+				   name_tag);
-	exp noff2 = getexp(sh(off), nilexp, 0, nilexp, noff1, 0, 0,
+		exp noff2 = getexp(sh(off), nilexp, 0, nilexp, noff1, 0, 0,
-			name_tag);
+				   name_tag);
-	exp idoff = getexp(s, nilexp, 0, off, noff2, 0, 2, ident_tag);
+		exp idoff = getexp(s, nilexp, 0, off, noff2, 0, 2, ident_tag);
-	son(noff1) = idoff; son(noff2) = idoff;
+		son(noff1) = idoff; son(noff2) = idoff;
-      {
+		{
-	exp addbf = f_offset_add( noff1, f_shape_offset(bfs) );
+			exp addbf = f_offset_add(noff1, f_shape_offset(bfs));
+			exp byteoffinit =
-	exp byteoffinit = f_offset_subtract(hold_check(f_offset_pad(als, addbf)),
+			    f_offset_subtract(hold_check(f_offset_pad(als,
+			    addbf)), hold_check(f_offset_pad(als,
-			hold_check(f_offset_pad(als, f_shape_offset(s))) );
+			    f_shape_offset(s))));
-	exp nby1 = getexp(os, nilexp, 0, nilexp, nilexp, 0, 0, name_tag);
+			exp nby1 = getexp(os, nilexp, 0, nilexp, nilexp, 0, 0,
+					  name_tag);
-	exp nby2 = getexp(os, nilexp, 0, nilexp, nby1, 0, 0, name_tag);
+			exp nby2 = getexp(os, nilexp, 0, nilexp, nby1, 0, 0,
+					  name_tag);
-	exp idby = getexp(s, nilexp, 0, byteoffinit, nby2, 0, 2, ident_tag);
+			exp idby = getexp(s, nilexp, 0, byteoffinit, nby2, 0, 2,
+					  ident_tag);
-	exp cnt; exp sh1; exp sh2; exp bitoff; exp shl;
+			exp cnt; exp sh1; exp sh2; exp bitoff; exp shl;
-	exp v = getexp(ulongsh, nilexp, 0, nilexp, nilexp, 0,
+			exp v = getexp(ulongsh, nilexp, 0, nilexp, nilexp, 0,
-			shape_size(s) - bf.bits, val_tag);
+				       shape_size(s) - bf.bits, val_tag);
-        exp v1bit = getexp(ob, nilexp, 0, nilexp, nilexp, 0, 1, val_tag);
+			exp v1bit = getexp(ob, nilexp, 0, nilexp, nilexp, 0, 1,
+					   val_tag);
-	son(nby1) = idby; son(nby2) = idby;
+			son(nby1) = idby; son(nby2) = idby;
-	cnt = f_contents(s, f_add_to_ptr(p, nby1));
+			cnt = f_contents(s, f_add_to_ptr(p, nby1));
+			bitoff =
-        bitoff = f_offset_div(ulongsh,
+			    f_offset_div(ulongsh, f_offset_subtract(noff2,
-	f_offset_subtract(noff2,f_offset_pad(f_alignment(bfs), nby2)),
+			    f_offset_pad(f_alignment(bfs), nby2)), v1bit);
-					v1bit);
 #if (little_end)
-	shl = f_minus(f_wrap, copy(v), bitoff);
+			shl = f_minus(f_wrap, copy(v), bitoff);
 #else
-	shl = bitoff;
+			shl = bitoff;
 #endif
-        sh1 = f_shift_left(f_wrap,cnt, shl);
+			sh1 = f_shift_left(f_wrap, cnt, shl);
-	sh2 = f_shift_right(sh1, v);
+			sh2 = f_shift_right(sh1, v);
-	bro(byteoffinit) = sh2; clearlast(byteoffinit);
+			bro(byteoffinit) = sh2; clearlast(byteoffinit);
-	bro(sh2) = idby; setlast(sh2);
+			bro(sh2) = idby; setlast(sh2);
-	bro(off) = idby; clearlast(off);
+			bro(off) = idby; clearlast(off);
-	bro(idby) = idoff; setlast(idby);
+			bro(idby) = idoff; setlast(idby);
-        return(f_change_int_to_bitfield(bf, idoff));
+			return (f_change_int_to_bitfield(bf, idoff));
-      }
-  }
+		}
+	}
+}
+exp
-exp f_bitfield_contents_with_mode
+f_bitfield_contents_with_mode(transfer_mode md, bitfield_variety bf, exp p,
-    PROTO_N ( (md, bf, p, off) )
+			      exp off)
-    PROTO_T ( transfer_mode md X bitfield_variety bf X exp p X exp off )
+{
-  exp res;
+	exp res;
-  if (name(sh(p)) == bothd)
+	if (name(sh(p)) == bothd) {
-    return p;
+		return p;
+	}
 #if check_shape
-  if (name(sh(p)) != ptrhd || name(sh(off)) != offsethd ||
+	if (name(sh(p)) != ptrhd || name(sh(off)) != offsethd ||
-	name(off) != val_tag)
+	    name(off) != val_tag) {
-    failer(CHSH_BFCONT);
+		failer(CHSH_BFCONT);
+	}
 #endif
 #ifdef no_trap_on_nil_contents
 	if ((md & f_trap_on_nil) != 0) {
 		exp d = me_startid(f_bitfield(bf), p, 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_list el;
 		exp test = me_q1(no_nat_option, f_equal, &lb, me_obtain(d),
-				f_make_null_ptr(al1_of(sh(p))), test_tag);
+				 f_make_null_ptr(al1_of(sh(p))), test_tag);
-		exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp,
+		exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,
-, f_nil_access, trap_tag);
+				 f_nil_access, trap_tag);
 		md &= ~f_trap_on_nil;
-     		el = new_exp_list(1);
+		el = new_exp_list(1);
-     		el = add_exp_list(el, test, 1);
+		el = add_exp_list(el, test, 1);
-     		return me_complete_id(d,
-		   f_conditional(&lb, f_sequence(el, trp),
+		return me_complete_id(d, f_conditional(&lb, f_sequence(el, trp),
-			f_bitfield_contents_with_mode(md, bf, me_obtain(d), off)) );
+		    f_bitfield_contents_with_mode(md, bf, me_obtain(d), off)));
-   	};
-#endif
-  if (md == f_volatile)
-    res = me_u3(f_bitfield(bf), p, bfcontvol_tag);
-  else
-    res = me_u3(f_bitfield(bf), p, bfcont_tag);
-  no(res) = no(off);
-  return res;
-}
-#if do_case_transforms
-exp f_case
-    PROTO_N ( (exhaustive, control, branches) )
-    PROTO_T ( bool exhaustive X exp control X caselim_list branches )
-{
-  exp r, ht;
-  shape case_shape;
-  exp changer;
-  exp body_of_ident;
-  exp control_expression;
-  exp body_of_case;
-  exp id;
-  exp copy_ce;
-  shape changer_shape = (shape_size(sh(control)) >= SLONG_SZ) ? sh(control)
-	: is_signed(sh(control)) ? slongsh : ulongsh;
-/*  UNUSED(branches);
-*/
-  if (name(sh(control)) == bothd)
-    return control;
-  bro(global_case) = nilexp;
-  while(branches != nilexp) {
-	exp hd = branches;
-	branches = bro(branches);
-	bro(hd) = nilexp;
-	sh(hd) = sh(control);
-	if (son(hd) != nilexp) {
-		sh(son(hd)) = sh(control);
+	}
-	if (son(hd) != nilexp && docmp_f((int)f_less_than, son(hd), hd)){
-	 	--no (son (pt(hd)));
-	 	retcell(son(hd));
-	 	retcell(hd);
-     	}
-	else
-		case_item(hd);
-  }
-  if (bro(global_case) == nilexp)
-    return control;
-  case_shape = (exhaustive) ? f_bottom : f_top;
-  if (PIC_code)
-    proc_externs = 1;
-#if check_shape
-  if (!is_integer(sh(control)))
-    failer(CHSH_CASE);
-#endif
-  r = getexp (case_shape, nilexp, 0, control, nilexp, 0,
-, case_tag);
-  clearlast(control);
-  bro(control) = bro(global_case);
-  ht = control;
-  while (bro (ht) != nilexp) {
-    ht = bro (ht);
-    sh(ht) = changer_shape;
-    if (son(ht) != nilexp)
-      sh(son(ht)) = changer_shape;
-  };
-  setlast (ht);
-  bro (ht) = r;
-  control_expression = son (r);
-  body_of_case = bro (son (r));
-  copy_ce = copy(control_expression);
-  changer = hold_check(me_u3 (changer_shape, control_expression, chvar_tag));
-  id = me_startid (sh (changer), changer, 1);
-	/* the shape of the ident will be overwritten by me_complete_id */
-  body_of_ident = case_optimisation (body_of_case, id, sh (r),
-  					copy_ce);
-  id = me_complete_id (id, body_of_ident);
-#ifdef NEWDIAGS
-  if (extra_diags)
-    id = f_dg_exp (id, f_branch_dg (f_dg_null_sourcepos));
 #endif
+	if (md == f_volatile) {
+		res = me_u3(f_bitfield(bf), p, bfcontvol_tag);
+	} else {
+		res = me_u3(f_bitfield(bf), p, bfcont_tag);
+	}
+	no(res) = no(off);
-  return (hold_check(id));
+	return res;
+}
-#else
+#if do_case_transforms
-exp f_case
+exp
-    PROTO_N ( (exhaustive, control, branches) )
-    PROTO_T ( bool exhaustive X exp control X caselim_list branches )
+f_case(bool exhaustive, exp control, caselim_list branches)
+{
+	exp r, ht;
+	shape case_shape;
+	exp changer;
+	exp body_of_ident;
+	exp control_expression;
+	exp body_of_case;
+	exp id;
+	exp copy_ce;
+	shape changer_shape = (shape_size(sh(control)) >= SLONG_SZ) ?
+	    sh(control) : is_signed(sh(control)) ? slongsh : ulongsh;
+	/*  UNUSED(branches);
+	 */
+	if (name(sh(control)) == bothd) {
+		return control;
+	}
+	bro(global_case) = nilexp;
+	while (branches != nilexp) {
+		exp hd = branches;
+		branches = bro(branches);
+		bro(hd) = nilexp;
+		sh(hd) = sh(control);
+		if (son(hd) != nilexp) {
+			sh(son(hd)) = sh(control);
+		}
+		if (son(hd) != nilexp &&
+		    docmp_f((int)f_less_than, son(hd), hd)) {
+			--no(son(pt(hd)));
+			retcell(son(hd));
+			retcell(hd);
+		} else {
+			case_item(hd);
+		}
+	}
+	if (bro(global_case) == nilexp) {
+		return control;
+	}
+	case_shape = (exhaustive)? f_bottom : f_top;
+	if (PIC_code) {
+		proc_externs = 1;
+	}
+#if check_shape
+	if (!is_integer(sh(control))) {
+		failer(CHSH_CASE);
+	}
+#endif
+	r = getexp(case_shape, nilexp, 0, control, nilexp, 0, 0, case_tag);
+	clearlast(control);
+	bro(control) = bro(global_case);
+	ht = control;
+	while (bro(ht) != nilexp) {
+		ht = bro(ht);
+		sh(ht) = changer_shape;
+		if (son(ht) != nilexp) {
+			sh(son(ht)) = changer_shape;
+		}
+	}
+	setlast(ht);
+	bro(ht) = r;
+	control_expression = son(r);
+	body_of_case = bro(son(r));
+	copy_ce = copy(control_expression);
+	changer = hold_check(me_u3(changer_shape, control_expression,
+				   chvar_tag));
+	id = me_startid(sh(changer), changer, 1);
+	/* the shape of the ident will be overwritten by me_complete_id */
+	body_of_ident = case_optimisation(body_of_case, id, sh(r), copy_ce);
+	id = me_complete_id(id, body_of_ident);
+#ifdef NEWDIAGS
+	if (extra_diags) {
+		id = f_dg_exp(id, f_branch_dg(f_dg_null_sourcepos));
+	}
+#endif
+	return (hold_check(id));
+}
+#else /* do_case_transforms */
+exp
+f_case(bool exhaustive, exp control, caselim_list branches)
+{
-  exp r, ht;
+	exp r, ht;
-  shape case_shape;
+	shape case_shape;
-/*  UNUSED(branches);
+	/*  UNUSED(branches);
-  if (name(sh(control)) == bothd || bro(global_case) == nilexp)
+	    if (name(sh(control)) == bothd || bro(global_case) == nilexp)
-    return control;
+	    return control;
-*/
+	 */
-  if (name(sh(control)) == bothd)
+	if (name(sh(control)) == bothd) {
-    return control;
+		return control;
+	}
-  bro(global_case) = nilexp;
+	bro(global_case) = nilexp;
-  while(branches != nilexp) {
+	while (branches != nilexp) {
-	exp hd = branches;
+		exp hd = branches;
-	branches = bro(branches);
+		branches = bro(branches);
-	bro(hd) = nilexp;
+		bro(hd) = nilexp;
-	sh(hd) = sh(control);
+		sh(hd) = sh(control);
-	if (son(hd) != nilexp) {
+		if (son(hd) != nilexp) {
-		sh(son(hd)) = sh(control);
+			sh(son(hd)) = sh(control);
-	}
+		}
+		if (son(hd) != nilexp &&
-	if (son(hd) != nilexp && docmp_f((int)f_less_than, son(hd), hd)){
+		    docmp_f((int)f_less_than, son(hd), hd)) {
-	 	--no (son (pt(hd)));
+			--no(son(pt(hd)));
-	 	retcell(son(hd));
+			retcell(son(hd));
-	 	retcell(hd);
+			retcell(hd);
-     	}
-	else
+		} else {
-		case_item(hd);
+			case_item(hd);
-  }
+		}
+	}
-  if (bro(global_case) == nilexp)
+	if (bro(global_case) == nilexp) {
-    return control;
+		return control;
+	}
-  case_shape = (exhaustive) ? f_bottom : f_top;
+	case_shape = (exhaustive) ? f_bottom : f_top;
-  if (PIC_code)
+	if (PIC_code) {
-    proc_externs = 1;
+		proc_externs = 1;
+	}
 #if check_shape
-  if (!is_integer(sh(control)))
+	if (!is_integer(sh(control))) {
-    failer(CHSH_CASE);
+		failer(CHSH_CASE);
+	}
 #endif
-  r = getexp (case_shape, nilexp, 0, control, nilexp, 0,
+	r = getexp(case_shape, nilexp, 0, control, nilexp, 0, 0, case_tag);
-, case_tag);
-  clearlast(control);
+	clearlast(control);
-  bro(control) = bro(global_case);
+	bro(control) = bro(global_case);
-  ht = control;
+	ht = control;
-  while (bro (ht) != nilexp) {
+	while (bro(ht) != nilexp) {
-    ht = bro (ht);
+		ht = bro(ht);
-    sh(ht) = sh(control);
+		sh(ht) = sh(control);
-    if (son(ht) != nilexp)
+		if (son(ht) != nilexp) {
-      sh(son(ht)) = sh(control);
+			sh(son(ht)) = sh(control);
-  };
+		}
+	}
-  setlast (ht);
+	setlast(ht);
-  bro (ht) = r;
+	bro(ht) = r;
 #ifdef NEWDIAGS
-  if (extra_diags)
+	if (extra_diags) {
-    r = f_dg_exp (r, f_branch_dg (f_dg_null_sourcepos));
+		r = f_dg_exp(r, f_branch_dg(f_dg_null_sourcepos));
+	}
 #endif
-  return (r);
+	return (r);
+}
+#endif /* do_case_transforms */
-#endif
-exp f_change_bitfield_to_int
+exp
-    PROTO_N ( (x, arg1) )
-    PROTO_T ( variety x X exp arg1 )
+f_change_bitfield_to_int(variety x, exp arg1)
+{
-  if (name(sh(arg1)) == bothd)
+	if (name(sh(arg1)) == bothd) {
-    return arg1;
+		return arg1;
+	}
 #if check_shape
-  if (name(sh(arg1)) != bitfhd)
+	if (name(sh(arg1)) != bitfhd) {
-    failer(CHSH_CHBITFIELD);
+		failer(CHSH_CHBITFIELD);
+	}
 #endif
 #if !has64bits
-	if (shape_size(x)>32) {
+	if (shape_size(x) >32) {
-		shape n32 = (is_signed(x))?slongsh:ulongsh;
+		shape n32 = (is_signed(x)) ? slongsh : ulongsh;
 		exp z = hold_check(me_c2(n32, arg1, bitf_to_int_tag));
 		return f_change_variety(f_impossible, x, z);
+	}
 #endif
-  return me_c2(f_integer(x), arg1, bitf_to_int_tag);
+	return me_c2(f_integer(x), arg1, bitf_to_int_tag);
 }
+exp
-exp f_change_int_to_bitfield
-    PROTO_N ( (x, arg1) )
-    PROTO_T ( bitfield_variety x X exp arg1 )
+f_change_int_to_bitfield(bitfield_variety x, exp arg1)
 {
-  if (name(sh(arg1)) == bothd)
+	if (name(sh(arg1)) == bothd) {
-    return arg1;
+		return arg1;
+	}
 #if check_shape
-  if (!is_integer(sh(arg1)))
+	if (!is_integer(sh(arg1))) {
-    failer(CHSH_CHINTBF);
+		failer(CHSH_CHINTBF);
+	}
 #endif
 #if !has64bits
-	if (shape_size(sh(arg1))>32) {
+	if (shape_size(sh(arg1)) >32) {
-		shape n32 = (is_signed(sh(arg1)))?slongsh:ulongsh;
+		shape n32 = (is_signed(sh(arg1))) ? slongsh : ulongsh;
 		arg1 = hold_check(f_change_variety(f_wrap, n32, arg1));
 	}
 #endif
-  return me_c2(f_bitfield(x), arg1, int_to_bitf_tag);
+	return me_c2(f_bitfield(x), arg1, int_to_bitf_tag);
 }
-exp f_change_variety
+exp
-    PROTO_N ( (ov_err, r, arg1) )
-    PROTO_T ( error_treatment ov_err X variety r X exp arg1 )
+f_change_variety(error_treatment ov_err, variety r, exp arg1)
 {
-  if (name(sh(arg1)) == bothd)
+	if (name(sh(arg1)) == bothd) {
-    return arg1;
+		return arg1;
+	}
 #if check_shape
-  if (!is_integer(sh(arg1)))
+	if (!is_integer(sh(arg1))) {
-    failer(CHSH_CHVAR);
+		failer(CHSH_CHVAR);
+	}
 #endif
 #if !has64bits
-  if ((name(arg1)!=val_tag || ov_err.err_code >2)
+	if ((name(arg1) != val_tag || ov_err.err_code > 2) &&
-		&&( shape_size(sh(arg1))> 32 || name(r)>=s64hd)
+	    (shape_size(sh(arg1)) > 32 || name(r) >=s64hd) &&
-		&& name(sh(arg1)) != name(r) ){
+	    name(sh(arg1)) != name(r)) {
-	   exp e = arg1;
+		exp e = arg1;
-	   int ss = is_signed(sh(arg1));
+		int ss = is_signed(sh(arg1));
-	   int sd = is_signed(r);
+		int sd = is_signed(r);
-	   shape x =(ss)?slongsh:ulongsh;
+		shape x = (ss)?slongsh:ulongsh;
-	   if (shape_size(sh(arg1)) <=32) {
+		if (shape_size(sh(arg1)) <= 32) {
-		exp e = hold_check(me_c1(x,ov_err, arg1, chvar_tag));
+			exp e = hold_check(me_c1(x, ov_err, arg1, chvar_tag));
-		exp z = TDFcallaux(ov_err, e,
+			exp z = TDFcallaux(ov_err, e, (sd) ? ((ss) ?
-				(sd)?((ss)?"__TDFUsswiden":"__TDFUuswiden"):
+			    "__TDFUsswiden" : "__TDFUuswiden") : (ss) ?
-				      (ss)?"__TDFUsuwiden":"__TDFUuuwiden", r);
+			    "__TDFUsuwiden" : "__TDFUuuwiden", r);
-		return z;
+			return z;
-	   }
-	   else
-	   if (name(r) >= s64hd) {
+		} else if (name(r) >= s64hd) {
-		return TDFcallaux(ov_err, e, (sd)?"__TDFUu642s64":"__TDFUs642u64", r);
+			return TDFcallaux(ov_err, e, (sd) ? "__TDFUu642s64" :
-	   }
+					  "__TDFUs642u64", r);
-	   else {
+		} else {
-		exp e = TDFcallaux(ov_err, arg1,
+			exp e = TDFcallaux(ov_err, arg1, (sd) ?
-				(sd)?((ss)?"__TDFUssshorten":"__TDFUusshorten"):
+			    ((ss) ? "__TDFUssshorten" : "__TDFUusshorten") :
-					(ss)?"__TDFUsushorten":"__TDFUuushorten",
+			    (ss) ?  "__TDFUsushorten" : "__TDFUuushorten",
-					(sd)?slongsh:ulongsh);
+			    (sd) ? slongsh : ulongsh);
-		return 	hold_check(me_c1(f_integer(r),ov_err, e, chvar_tag));
+			return hold_check(me_c1(f_integer(r), ov_err, e,
+						chvar_tag));
-	   }
+		}
+	}
+#endif
+	return me_c1(f_integer(r), ov_err, arg1, chvar_tag);
+}
+exp
+f_component(shape sha, 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 (!doing_aldefs &&
+	    (name(sh(arg2)) != offsethd || name(sh(arg1)) != cpdhd ||
+	     shape_align(sh(arg1)) < al1(sh(arg2)) ||
+	     shape_align(sha) > al2(sh(arg2)))) {
+		failer(CHSH_COMPONENT);
-  }
+	}
 #endif
-  return me_c1(f_integer(r), ov_err, arg1, chvar_tag);
+	return me_b3(sha, arg1, arg2, component_tag);
+}
+exp
-exp f_component
-    PROTO_N ( (sha, arg1, arg2) )
-    PROTO_T ( shape sha X exp arg1 X exp arg2 )
+f_concat_nof(exp arg1, exp arg2)
+{
-  if (name(sh(arg1)) == bothd)
-    { kill_exp(arg2,arg2); return arg1; }
+	shape sha = getshape(0, const_al1, al2_of(sh(arg1)), align_of(sh(arg1)),
-  if (name(sh(arg2)) == bothd)
-    { kill_exp(arg1,arg1); return arg2; }
+			     shape_size(sh(arg1)) + shape_size(sh(arg2)),
-#if check_shape
+			     nofhd);
-  if (!doing_aldefs &&
-	(name(sh(arg2)) != offsethd || name(sh(arg1)) != cpdhd ||
-       shape_align(sh(arg1)) < al1(sh(arg2)) ||
+	if (name(sh(arg1)) == bothd) {
-       shape_align(sha) > al2(sh(arg2))))
-    failer(CHSH_COMPONENT);
+		kill_exp(arg2, arg2);
-#endif
+		return arg1;
-   return me_b3(sha, arg1, arg2, component_tag);
-}
+	}
-exp f_concat_nof
+	if (name(sh(arg2)) == bothd) {
-    PROTO_N ( (arg1, arg2) )
+		kill_exp(arg1, arg1);
-    PROTO_T ( exp arg1 X exp arg2 )
+		return arg2;
-{
+	}
-  shape sha = getshape(0, const_al1, al2_of(sh(arg1)),
-			align_of(sh(arg1)),
-                        shape_size(sh(arg1)) + shape_size(sh(arg2)),
-                       nofhd);
-  if (name(sh(arg1)) == bothd)
-    { kill_exp(arg2,arg2); return arg1; }
-  if (name(sh(arg2)) == bothd)
-    { kill_exp(arg1,arg1); return arg2; }
 	/* al2_of(sh(arg1)) is the shapemacs.h hd of the nof shape */
 #if check_shape
-  if (!doing_aldefs &&
-	(shape_align(sh(arg1)) != shape_align(sh(arg2))))
+	if (!doing_aldefs && (shape_align(sh(arg1)) != shape_align(sh(arg2)))) {
-    failer(CHSH_CONCATNOF);
+		failer(CHSH_CONCATNOF);
-#endif
-  return me_b3(sha, arg1, arg2, concatnof_tag);
-}
-exp f_conditional
-    PROTO_N ( (alt_label_intro, first, alt) )
-    PROTO_T ( label alt_label_intro X exp first X exp alt )
-{
-   shape res_shape;
-   exp r, labst, def;
-   labst = get_lab(alt_label_intro);
-   res_shape = lub_shape (sh (first), sh (alt));
-   r = getexp (res_shape, nilexp, 0, first, nilexp, 0,
-, cond_tag);
-   def = son(labst);
-   setbro(first, labst);
-   clearlast(first);
-   setbro(def, alt);
-   clearlast(def);
-   setbro(alt, labst);
-   setlast(alt);
-   setsh(labst, sh(alt));
-   setfather (r, labst);
-   default_freq = (float) (2.0 * default_freq);
-   return r;
-}
-void start_conditional
-    PROTO_N ( (alt_label_intro) )
-    PROTO_T ( label alt_label_intro )
-{
-  exp tg;
-  exp labst;
-  tg = getexp (f_top, nilexp, 0, nilexp, nilexp, 0, 0,
-                    clear_tag);
-  labst = getexp (f_bottom, nilexp, 0, tg, nilexp,
-, 0, labst_tag);
-  default_freq = (float) (default_freq / 2.0);
-  fno(labst) = default_freq;
-  ++proc_label_count;
-  set_lab(alt_label_intro, labst);
-  return;
-}
+	}
-exp f_contents
-    PROTO_N ( (s, arg1) )
-    PROTO_T ( shape s X exp arg1 )
-{
-  if (name(sh(arg1)) == bothd)
-    return arg1;
-#if check_shape
-  if (!doing_aldefs &&
-	(name(sh(arg1)) != ptrhd ||
-	   (al1(sh(arg1)) < shape_align(s)
-#if issparc
-		&& align_of(s) != REAL_ALIGN
 #endif
-	   ) )) {
-    failer(CHSH_CONTENTS);
-  }
-#endif
+	return me_b3(sha, arg1, arg2, concatnof_tag);
+}
+exp
+f_conditional(label alt_label_intro, exp first, exp alt)
+{
+	shape res_shape;
+	exp r, labst, def;
-  return me_c2(s, arg1, cont_tag);
+	labst = get_lab(alt_label_intro);
+	res_shape = lub_shape(sh(first), sh(alt));
+	r = getexp(res_shape, nilexp, 0, first, nilexp, 0, 0, cond_tag);
+	def = son(labst);
+	setbro(first, labst);
+	clearlast(first);
+	setbro(def, alt);
+	clearlast(def);
+	setbro(alt, labst);
+	setlast(alt);
+	setsh(labst, sh(alt));
+	setfather(r, labst);
+	default_freq = (float)(2.0 * default_freq);
+	return r;
+}
+void
+start_conditional(label alt_label_intro)
+{
+	exp tg;
+	exp labst;
+	tg = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, clear_tag);
+	labst = getexp(f_bottom, nilexp, 0, tg, nilexp, 0, 0, labst_tag);
+	default_freq = (float)(default_freq / 2.0);
+	fno(labst) = default_freq;
+	++proc_label_count;
+	set_lab(alt_label_intro, labst);
+	return;
 }
+exp
-exp f_contents_with_mode
+f_contents(shape s, exp arg1)
+{
+	if (name(sh(arg1)) == bothd) {
+		return arg1;
+	}
+#if check_shape
+	if (!doing_aldefs &&
-    PROTO_N ( (md, s, arg1) )
+	    (name(sh(arg1)) != ptrhd ||
+	     (al1(sh(arg1)) < shape_align(s)
+#if issparc
+	      && align_of(s) != REAL_ALIGN
+#endif
+	      ))) {
+		failer(CHSH_CONTENTS);
+	}
+#endif
+	return me_c2(s, arg1, cont_tag);
+}
+exp
-    PROTO_T ( transfer_mode md X shape s X exp arg1 )
+f_contents_with_mode(transfer_mode md, shape s, exp arg1)
 {
-  if (name(sh(arg1)) == bothd)
+	if (name(sh(arg1)) == bothd) {
-    return arg1;
+		return arg1;
+	}
 #if check_shape
-  if (!doing_aldefs &&
+	if (!doing_aldefs &&
-	(name(sh(arg1)) != ptrhd ||
+	    (name(sh(arg1)) != ptrhd ||
-	   (al1(sh(arg1)) < shape_align(s)
+	     (al1(sh(arg1)) < shape_align(s) &&
-		&& al1_of(sh(arg1))-> al.sh_hd != doublehd) ))
+	      al1_of(sh(arg1))->al.sh_hd != doublehd))) {
-    failer(CHSH_CONTENTS_VOL);
+		failer(CHSH_CONTENTS_VOL);
+	}
 #endif
 #ifdef no_trap_on_nil_contents
 	if ((md & f_trap_on_nil) != 0) {
 		exp d = me_startid(s, 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_list el;
 		exp test = me_q1(no_nat_option, f_equal, &lb, me_obtain(d),
-				f_make_null_ptr(f_alignment(s)), test_tag);
+				 f_make_null_ptr(f_alignment(s)), test_tag);
-		exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp,
+		exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,
-, f_nil_access, trap_tag);
+				 f_nil_access, trap_tag);
 		md &= ~f_trap_on_nil;
-     		el = new_exp_list(1);
+		el = new_exp_list(1);
-     		el = add_exp_list(el, test, 1);
+		el = add_exp_list(el, test, 1);
-     		return me_complete_id(d,
-		   f_conditional(&lb, f_sequence(el, trp),
+		return me_complete_id(d, f_conditional(&lb, f_sequence(el, trp),
-				f_contents_with_mode(md, s, me_obtain(d))) );
+		    f_contents_with_mode(md, s, me_obtain(d))));
-   	};
+	}
 #endif
-  if (md & f_volatile)
+	if (md & f_volatile) {
-    return me_c2(s, arg1, contvol_tag);
+		return me_c2(s, arg1, contvol_tag);
-  else
+	} else {
-    return me_c2(s, arg1, cont_tag);
+		return me_c2(s, arg1, cont_tag);
+	}
 }
+exp
-exp f_current_env
+f_current_env(void)
+{
+	if (!in_proc_def) {
+		failer("current_env must be in proc definition");
+	}
-    PROTO_Z ()
+	uses_crt_env = 1;
+	uses_loc_address = 1;
+	return getexp(f_pointer(frame_alignment), nilexp, 0, nilexp, nilexp, 0,
+, current_env_tag);
+}
+int
+eq_et(error_treatment a, error_treatment b)
+{
-  if (!in_proc_def) failer("current_env must be in proc definition");
-  uses_crt_env = 1;
-  uses_loc_address = 1;
-  return getexp(f_pointer(frame_alignment), nilexp, 0,
+	return (a.err_code == b.err_code &&
-                  nilexp, nilexp, 0, 0, current_env_tag);
+		(a.err_code != 4 || a.jmp_dest == b.jmp_dest));
+}
-int eq_et
-    PROTO_N ( (a, b) )
-    PROTO_T ( error_treatment a X error_treatment b )
-{
-	return ( a.err_code == b.err_code
-		 && (a.err_code != 4 || a.jmp_dest == b.jmp_dest)
-		);
-}
-exp div_rem
+exp
-    PROTO_N ( (div0_err, ov_err, arg1, arg2, f) )
-    PROTO_T ( error_treatment div0_err X error_treatment ov_err X exp arg1 X
+div_rem(error_treatment div0_err, error_treatment ov_err, exp arg1, exp arg2,
-	      exp arg2 X exp (*f) PROTO_S ((error_treatment, exp, exp)) )
+	exp(*f)(error_treatment, exp, exp))
+{
 	if (eq_et(div0_err, ov_err) || eq_et(ov_err, f_impossible)) {
 		return f(div0_err, arg1, arg2);
-	}
-	else
-	if (eq_et(div0_err, f_impossible)) {
+	} else if (eq_et(div0_err, f_impossible)) {
 		return f(ov_err, arg1, arg2);
-	}
-	else {
+	} else {
 		exp da2 = me_startid(sh(arg1), arg2, 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 tst = f_integer_test(no_nat_option, f_equal, &lb,
-				 me_obtain(da2), me_shint(sh(arg2), 0));
+					 me_obtain(da2), me_shint(sh(arg2), 0));
 		exp_list st;
 		exp wrong;
 		st = new_exp_list(1);
-		st = add_exp_list(st,tst,0);
+		st = add_exp_list(st, tst, 0);
 		if (div0_err.err_code == 4) {
 			wrong = f_goto(div0_err.jmp_dest);
-		}
-		else
-		if (div0_err.err_code > 4) {
+		} else if (div0_err.err_code > 4) {
 			wrong = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,
-				f_overflow, trap_tag);
+				       f_overflow, trap_tag);
-		}
-		else {
+		} else {
 			wrong = me_shint(sh(arg1), 0);
 #if check_shape
+	{
+		exp temp = first;
+		while (1) {
-  if (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1)))
+			if (!eq_shape(sh(temp), sh(first))) {
-    failer(CHSH_DIV1);
+				failer(CHSH_MAKENOF);
+			}
+			if (temp == arg1.end) {
+				break;
+			}
+			temp = bro(temp);
+		}
+	}
 #endif
+	if (name(sh(first)) == bitfhd) {
+		/* make make_nof bitbields into make-compound */
+		int sf = shape_size(sh(first));
+		int snof = shape_size(sh(r));
+		exp *a = &arg1.start;
+		int scs = (((sf - 1) &sf) == 0) ? sf : snof;
+		shape cs = containedshape(scs, 1);
+		int i;
+		shape cpds = f_compound(hold_check(f_offset_pad(f_alignment(cs),
+		    f_shape_offset(sh(r)))));
+		exp soff = getexp(f_offset(f_alignment(cpds),
+					   f_alignment(sh(first))),
-  return div_rem(div0_err, ov_err, arg1, arg2, div1_aux);
+				  nilexp, 0, nilexp, nilexp, 0, 0, val_tag);
+		for (i = 0; i < arg1.number; i++) {
+			bro(soff) = *a;
+			*a = copyexp(soff);
+			a = &bro(bro(*a));
+			no(soff) += sf;
+		}
+		arg1.number *= 2;
+		return f_make_compound(hold_check(f_shape_offset(cpds)), arg1);
+	}
+	setfather(r, arg1.end);
+	return r;
 }
+exp
+f_make_nof_int(variety v, string s)
+{
+	shape sha;
-exp div2_aux
+	exp res;
+	nat t;
+	int i;
+	shape elem_sh = f_integer(v);
+	int elem_sz = shape_size(elem_sh);
+	if (PIC_code) {
+		proc_externs = 1;
+	}
+	nat_issmall(t) = 1;
+	natint(t) = s.number;
+	sha = f_nof(t, elem_sh);
+	res = getexp(sha, nilexp, 0, nilexp, nilexp, (prop)elem_sz, 0,
+		     string_tag);
+	if (elem_sz == 64) {
+		int *ss = (int *)xcalloc(s.number, sizeof(int));
+		for (i = 0; i < s.number; ++i) {
+			flt64 x;
+			flpt f;
+			int ov;
+			int sg = is_signed(elem_sh);
+			x.big = 0;
+			switch (s.size) {
+			case 8:
+				x.small = (unsigned int)s.ints.chars[i];
+				break;
+			case 16:
+				x.small = (unsigned int)s.ints.shorts[i];
+				break;
+			case 32:
+				x.small = (unsigned int)s.ints.longs[i];
+				break;
+			default:
+				f = (flpt)s.ints.longs[i];
+				x = flt_to_f64(f, 0, &ov);
+				flpt_ret(f);
-    PROTO_N ( (ov_err, arg1, arg2) )
+				if (s.size < 64 && sg) {
+					x.big = (x.big << (64 - s.size)) >>
+					    (64 - s.size);
+				}
+			}
+			ss[i] = f64_to_flt(x, sg);
+		}
+		nostr(res) = (char *)(void *)ss;
+		return res;
+	}
+	switch (s.size) {
+	case 8:
+		switch (elem_sz) {
+		case 8:
+			nostr(res) = (char *)s.ints.chars;
+			return res;
+		case 16: {
-    PROTO_T ( error_treatment ov_err X exp arg1 X exp arg2 )
+			short *ss = (short *)xcalloc(s.number, sizeof(short));
+			for (i = 0; i < s.number; ++i) {
+				ss[i] = (short)(unsigned char)s.ints.chars[i];
+			}
+			nostr(res) = (char *)(void *)ss;
+			return res;
+		}
+		case 32: {
+			int *ss = (int *)xcalloc(s.number, sizeof(int));
+			for (i = 0; i < s.number; ++i) {
+				ss[i] = (int)(unsigned char)s.ints.chars[i];
+			}
+			nostr(res) = (char *)(void *)ss;
+			return res;
+		}
+		}
+	case 16:
+		switch (elem_sz) {
+		case 8: {
+			char *ss = (char *)xcalloc(s.number, sizeof(char));
+			for (i = 0; i < s.number; ++i) {
+				ss[i] = (char)(unsigned short)s.ints.shorts[i];
+			}
+			nostr(res) = (char *)(void *)ss;
+			return res;
+		}
+		case 16:
+			nostr(res) = (char *)(void *)s.ints.shorts;
+			return res;
+		case 32: {
+			int *ss = (int *)xcalloc(s.number, sizeof(int));
+			for (i = 0; i < s.number; ++i) {
+				ss[i] = (int)(unsigned short)s.ints.shorts[i];
+			}
+			nostr(res) = (char *)(void *)ss;
+			return res;
+		}
+		}
+	case 32:
+		switch (elem_sz) {
+		case 8: {
+			char *ss = (char *)xcalloc(s.number, sizeof(char));
+			for (i = 0; i < s.number; ++i) {
+				ss[i] = (char)(unsigned long)s.ints.longs[i];
+			}
+			nostr(res) = (char *)(void *)ss;
+			return res;
+		}
+		case 16: {
+			short *ss = (short *)xcalloc(s.number, sizeof(short));
+			for (i = 0; i < s.number; ++i) {
+				ss[i] = (short)(unsigned long)s.ints.longs[i];
+			}
+			nostr(res) = (char *)(void *)ss;
+			return res;
+		}
+		case 32:
+			nostr(res) = (char *)(void *)s.ints.longs;
+			return res;
+		}
+	}
+	return res;
+}
+exp
+f_make_null_local_lv(void)
 {
+	return me_null(f_local_label_value, lv_null, null_tag);
+}
+exp
-#if !has64bits
+f_make_null_proc(void)
+{
+	return me_null(f_proc, proc_null, null_tag);
+}
+exp
+f_make_null_ptr(alignment a)
+{
+	return me_null(f_pointer(a), ptr_null, null_tag);
+}
+exp
+f_maximum(exp arg1, exp arg2)
+{
-	if (name(sh(arg1)) >= s64hd &&
+	if (name(sh(arg1)) == bothd) {
-		(name(arg1)!=val_tag || name(arg2) != val_tag
+		kill_exp(arg2, arg2);
+		return arg1;
+	}
-			|| ov_err.err_code > 2)) {
+	if (name(sh(arg2)) == bothd) {
-		return TDFcallop2(ov_err,arg1,arg2,div2_tag);
+		kill_exp(arg1, arg1);
+		return arg2;
+	}
-#endif
-  return me_b1(ov_err, arg1, arg2, div2_tag);
-}
-exp f_div2
-    PROTO_N ( (div0_err, ov_err, arg1, arg2) )
-    PROTO_T ( error_treatment div0_err X error_treatment ov_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 (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1)))
+	if (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1))) {
-    failer(CHSH_DIV2);
+		failer(CHSH_MAX);
+	}
 #endif
-  return div_rem(div0_err, ov_err, arg1, arg2, div2_aux);
-}
-exp f_env_offset
+#if !has64bits
-    PROTO_N ( (fa, y, t) )
+	if (name(sh(arg1)) >= s64hd &&
-    PROTO_T ( alignment fa X alignment y X tag t )
+	    (name(arg1) != val_tag || name(arg2) != val_tag)) {
-{
-  exp e = get_tag(t);
-  shape s = f_offset(fa, y);
-  exp res;
-  if (e == nilexp) {
-	e = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,
-, ident_tag);
-	son(e) = e; /* used to indicate that tag is not yet defined!?*/
-	set_tag(t, e);
-  }
-  res = getexp(s, nilexp, 0, e, nilexp, 0, 0, env_offset_tag);
-  setvis(e);
-  setenvoff(e);
-  return res;
-}
-exp f_fail_installer
-    PROTO_N ( (message) )
-    PROTO_T ( string message )
-{
-  char * m = (char *)xcalloc(message.number+1, sizeof(char));
-  int i;
-  for (i=0; i<message.number; ++i)
-    m[i] = message.ints.chars[i];
-  m[message.number] = 0;
-  failer(m);
-  exit(EXIT_FAILURE);
-  return(nilexp);
-}
-exp f_goto
-    PROTO_N ( (dest) )
-    PROTO_T ( label dest )
-{
-  exp lab = get_lab(dest);
-  exp r = getexp(f_bottom, nilexp, 0, nilexp, lab,
-, 0, goto_tag);
+		return TDFcallop3(arg1, arg2, max_tag);
-  ++no(son(lab));
-  return r;
-}
+	}
-exp f_goto_local_lv
-    PROTO_N ( (arg1) )
-    PROTO_T ( exp arg1 )
-{
-  if (name(sh(arg1)) == bothd)
-    return arg1;
-#if check_shape
-  if (name(sh(arg1)) != ptrhd)
-    failer(CHSH_GOLOCALLV);
 #endif
-  return me_u3(f_bottom, arg1, goto_lv_tag);
-}
-exp f_identify
-    PROTO_N ( (acc, name_intro, definition, body) )
-    PROTO_T ( access_option acc X tag name_intro X exp definition X exp body )
-{
-  exp i = get_tag(name_intro);
-  exp d = son(i);
-  UNUSED(acc);
-  if (name(sh(definition)) == bothd)
-    { kill_exp(body,body); return definition; }
-  setsh(i, sh(body));
-  setbro(d, body);
-  clearlast(d);
-  setfather (i, body);
-  return i;
-}
-void start_identify
-    PROTO_N ( (acc, name_intro, definition) )
-    PROTO_T ( access_option acc X tag name_intro X exp definition )
-{
-  exp i = get_tag(name_intro);
-  if (i == nilexp || son(i) != i) {
-	i = getexp(f_bottom, nilexp, 0, definition, nilexp, 0,
-, ident_tag);
-  }
-  else {  /* could have been already used in env_offset */
-	son(i) = definition;
-  }
-  clearvar(i);
-  if ((acc & (f_visible | f_long_jump_access)) != 0)
-   {
-    setvis(i);
-   };
-  set_tag(name_intro, i);
-  return;
-}
-exp f_ignorable
-    PROTO_N ( (arg1) )
-    PROTO_T ( exp arg1 )
-{
-  if (name(sh(arg1)) == bothd)
-    return arg1;
-  return me_u2(arg1, ignorable_tag);
+	return me_b2(arg1, arg2, max_tag);
+}
+exp
-exp f_integer_test
-    PROTO_N ( (prob, nt, dest, arg1, arg2) )
+f_minimum(exp arg1, exp arg2)
-    PROTO_T ( nat_option prob X ntest nt X label dest X exp arg1 X 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)) || !eq_shape(sh(arg1), sh(arg2)))
+	if (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1))) {
-    failer(CHSH_INTTEST);
+		failer(CHSH_MIN);
+	}
 #endif
 #if !has64bits
 	if (name(sh(arg1)) >= s64hd &&
-		(name(arg1)!=val_tag || name(arg2) != val_tag)) {
+	    (name(arg1) != val_tag || name(arg2) != val_tag)) {
 		error_treatment ov_err;
 		ov_err = f_wrap;
-		arg1 = TDFcallop2(ov_err,arg1,arg2,test_tag);
+		return TDFcallop2(ov_err, arg1, arg2, min_tag);
-		arg2 = getexp(slongsh, nilexp, 0, nilexp, nilexp, 0,
-, val_tag);
+	}
 #endif
-  if (nt == f_comparable || nt == f_not_comparable)
-    return replace_ntest(nt, dest, arg1, arg2);
-  else
-    return me_q1(prob, convert_ntest[nt], dest, arg1, arg2, test_tag);
-}
-exp f_labelled
-    PROTO_N ( (placelabs_intro, starter, places) )
-    PROTO_T ( label_list placelabs_intro X exp starter X exp_list places )
-{
-  exp f = places.start;
-  exp b;
-  int i;
-  clear_exp_list(places);
-  for (i=0; i<places.number; ++i)
-   {exp labst = get_lab(placelabs_intro.elems[i]);
-    b = bro(f);
-    setbro(son(labst), f);
-    setbro(f, labst);
-    setlast(f);
-    setsh(labst, sh(f));
-    if (name(starter) == case_tag ||
-	(name(starter) == seq_tag && name(son(son(starter))) == case_tag))
-      fno(labst) = (float)(1.0/places.number);
-    else
-      fno(labst) = (float)5.0;
-    f = b;
-   };
-  return(clean_labelled(starter, placelabs_intro));
+	return me_b2(arg1, arg2, min_tag);
+}
+static int in_initial_value;
-void start_labelled
+static void
+push_proc_props(void)
+{
+	proc_props *temp = (proc_props *)xcalloc(1, sizeof(proc_props));
+	temp->proc_struct_result = proc_struct_result;
+	temp->has_alloca = has_alloca;
+	temp->proc_is_recursive = proc_is_recursive;
+	temp->uses_crt_env = uses_crt_env;
-    PROTO_N ( ( placelabs_intro) )
+	temp->has_setjmp = has_setjmp;
+	temp->uses_loc_address = uses_loc_address;
-    PROTO_T ( label_list placelabs_intro )
+	temp->proc_label_count = proc_label_count;
+	temp->proc_struct_res = proc_struct_res;
+	temp->default_freq = default_freq;
+	temp->proc_externs = proc_externs;
+	temp->in_proc_def = in_proc_def;
+	temp->pushed = old_proc_props;
+	temp->rep_make_proc = rep_make_proc;
+	temp->frame_alignment = frame_alignment;
+	temp->in_initial_value = in_initial_value;
+	old_proc_props = temp;
+	return;
+}
+static void
+pop_proc_props(void)
+{
+	proc_props *temp = old_proc_props;
+	proc_struct_result = temp->proc_struct_result;
-  UNUSED(placelabs_intro);
+	has_alloca = temp->has_alloca;
+	proc_is_recursive =temp->proc_is_recursive;
-  if (crt_repeat != nilexp)
+	uses_crt_env = temp->uses_crt_env;
-	  ++no (crt_repeat);
+	has_setjmp = temp->has_setjmp;
+	uses_loc_address = temp->uses_loc_address;
+	proc_label_count = temp->proc_label_count;
+	proc_struct_res = temp->proc_struct_res;
+	default_freq = temp->default_freq;
-  repeat_list = getexp (f_top, crt_repeat, 0, nilexp,
+	proc_externs = temp->proc_externs;
+	in_proc_def = temp->in_proc_def;
-	    repeat_list, 0, 0, 0);
+	old_proc_props = temp->pushed;
+	rep_make_proc = temp->rep_make_proc;
-  crt_repeat = repeat_list;
+	frame_alignment = temp->frame_alignment;
+	in_initial_value = temp->in_initial_value;
+	if (temp != &initial_value_pp) {
+		xfree((void *)temp);
+	}
+	return;
+}
+void
+start_make_proc(shape result_shape, tagshacc_list params_intro,
+		tagacc_option vartag)
+{
+	/* initialise global flags which are used at the end of the
+	   reading process in f_make_proc */
+	UNUSED(result_shape); UNUSED(params_intro);
+	push_proc_props();
+	proc_struct_result = nilexp;
+	has_alloca = 0;
+	proc_is_recursive = 0;
+	uses_crt_env = 0;
+	has_setjmp = 0;
+	uses_loc_address = 0;
+	proc_label_count = 0;
+	proc_struct_res = 0;
+	default_freq = 1.0;
+	proc_externs = 0;
+	in_initial_value = 0;
+	frame_alignment = f_unite_alignments(f_locals_alignment,
+					     var_callers_alignment);
+	if (vartag.present) {
+		shape sha = getshape(0, const_al1, const_al1, VAR_PARAM_ALIGN,
+, cpdhd);
+		exp d = getexp(sha, nilexp, 0, nilexp, nilexp, 0, 0, clear_tag);
+		exp i = getexp(f_bottom, nilexp, 1, d, nilexp, 0, 0, ident_tag);
+		setvis(i);
+		setvar(i);
+		setparam(i);
+		set_tag(vartag.val.tg, i);
+	}
+	/* set this flag to distinguish values created during procedure
+	   reading. */
+	in_proc_def = 1;
-  return;
+	return;
+}
-exp f_last_local
+exp
-    PROTO_N ( (x) )
+f_make_proc(shape result_shape, tagshacc_list params_intro,
-    PROTO_T ( exp x )
+	    tagacc_option vartag, exp body)
+{
-  UNUSED(x);
+	exp res;
-  return getexp(f_pointer(f_alloca_alignment), nilexp, 0, nilexp, nilexp,
-, 0, last_local_tag);
-}
-exp f_local_alloc
+	int varhack = 0;
-    PROTO_N ( (arg1) )
-    PROTO_T ( exp arg1 )
+#if ishppa
-{
-  alignment a;
+	exp t, id, ptr;
-  if (name(sh(arg1)) == bothd)
-    return arg1;
+#endif
 #if check_shape
-  if (name(sh(arg1)) != offsethd)
+	if (name(sh(body)) != bothd) {
-    failer(CHSH_LOCALLOC);
+		failer(CHSH_MAKE_PROC);
+	}
+#endif
+	if (vartag.present) {
+		exp i = get_tag(vartag.val.tg);
+		if (params_intro.id == nilexp) {
+			params_intro.id = i;
+		} else {
+			bro(params_intro.last_def) = i;
+		}
+		bro(i) = params_intro.last_id;
+		params_intro.last_def = son(i);
+		params_intro.last_id = i;
+		setvis(i);
+		++params_intro.number;
+		varhack = 1;
+	}
+	res = getexp(f_proc, nilexp, 0, params_intro.id, result_shape, 0, 0,
+		     proc_tag);
+	if (params_intro.number == 0) {
+		son(res) = body;
+		setlast(body);
+		bro(body) = res;
+	} else {
+		bro(son(res)) = res;
+		bro(params_intro.last_def) = body;
+		setlast(body);
+		bro(body) = params_intro.last_id;
+#ifdef promote_pars
+		promote_formals(son(res));
+#endif
+	}
+	/* set the properties of the procedure construction from the
+	   global values accumulated during reading.
+	   WE OUGHT TO POP THE OLD VALUES.
+	 */
+	if (has_alloca) {
+		set_proc_has_alloca(res);
+	}
+	if (proc_is_recursive) {
+		setrecursive(res);
+	}
+	if (has_lv) {
+		set_proc_has_lv(res);
+	}
+	if (uses_crt_env) {
+		set_proc_uses_crt_env(res);
+	}
+	if (has_setjmp) {
+		set_proc_has_setjmp(res);
+	}
+	if (uses_loc_address) {
+		set_loc_address(res);
+	}
+	if (proc_struct_res) {
+		set_struct_res(res);
+	}
+	if (proc_externs) {
+		set_proc_uses_external(res);
+	}
+	/* apply check_id to the parameters */
+	if (params_intro.number != 0) {
+		exp param;
+		for (param = params_intro.last_id; param != res;
+		     param = bro(param)) {
+			if (redo_structparams &&
+#if ishppa
+			    (varhack || ((shape_size(sh(son(param))) >64) &&
+					 (name(sh(son(param))) == cpdhd ||
+					  name(sh(son(param))) == nofhd ||
+					  name(sh(son(param))) == doublehd))))
+#else
+#if issparc
+			    (varhack || sparccpd(sh(son(param)))))
+#else
+			    (varhack || name(sh(son(param))) == cpdhd ||
+			     name(sh(son(param))) == nofhd ||
+			     name(sh(son(param))) == doublehd))
+#endif
+#endif
+			{
+				/*
+				 * Param IS struct/union-by-value.  Incoming
+				 * acutal parameter will have been changed to
+				 * be ptr-to expected value (see
+				 * f_apply_proc()), so adjust usage in body.
+				 */
+				exp use;	/* use of ident in pt() chain */
+				exp prev;	/* previous use in pt() chain */
+				exp eo = nilexp;
+				shape ptr_s =
+				    f_pointer(f_alignment(sh(son(param))));
+#if ishppa
+				/* modify parameter itself */
+				if (!varhack) {
+					exp obtain_param;
+					exp assign;
+					shape sha=sh(son(param));
+					t=me_obtain(param);
+					if (uses_crt_env) {
+						eo = f_env_offset(
+						     frame_alignment,
+						     f_parameter_alignment(
+						     ptr_s), brog(param));
+						obtain_param =
+						    f_add_to_ptr(
+						    f_current_env(), eo);
+					}
+					id = me_startid(f_top,
+							me_u3(sha, t, cont_tag),
+);
+					ptr = me_startid(f_top, me_obtain(id),
+);
+					if (uses_crt_env) {
+						assign =
+						    f_assign(obtain_param,
+							     me_obtain(id));
+						body = f_sequence(add_exp_list(
+						       new_exp_list(1), assign,
+), body);
+					}
+					clearlast(son(ptr));
+					bro(son(ptr)) = body;
+					setlast(body);
+					bro(body) = ptr;
+					sh(ptr) = sh(body);
+					body = id;
+					clearlast(son(id));
+					bro(son(id)) = ptr;
+					setlast(ptr);
+					bro(ptr) = id;
+					sh(id) = sh(ptr);
+					bro(params_intro.last_def) = body;
+					setlast(body);
+					bro(body) = param;
+				}
+#endif
+				/* visit each use of the parameter modifying
+				   appropriately*/
+				for (prev = param, use = pt(prev);
+				     use != nilexp;
+				     prev = use, use = pt(prev)) {
+					if (!uses_crt_env ||
+					    (uses_crt_env && use != eo)) {
+						if (!isvar(param)) {
+							/* add cont */
+							exp new_use =
+							    getexp(ptr_s, use,
+								   (bool)1,
+								   son(use),
+								   pt(use),
+								   props(use),
+, name_tag);
+							son(use) = new_use;
+							pt(prev) = new_use;
+							pt(use) = nilexp;
+							props(use) = (prop)0;
+							setname(use, cont_tag);
+							/* retain same no and
+							   sh */
+							use = new_use;
+						}
+						if (no(use) > 0) {
+							/* add reff */
+							exp new_use =
+							    getexp(ptr_s, use,
+								   (bool)1,
+								   son(use),
+								   pt(use),
+								   props(use),
+, name_tag);
+							son(use) = new_use;
+							pt(prev) = new_use;
+							pt(use) = nilexp;
+							props(use) = (prop)0;
+							setname(use, reff_tag);
+							/* retain same no and
+							   sh */
+							use = new_use;
+						}
+					}
+				} /* for */
+#if ishppa
+				if (!varhack) {
+					/* Change all but ptr's references to
+					   param to references to ptr */
+					for (use = pt(param); use != nilexp;
+					     use = pt(use)) {
+						if ((son(use) ==param) &&
+						    (use != son(son(id))) &&
+						    (!uses_crt_env ||
+						     (uses_crt_env &&
+						      use != eo))) {
+							son(use) =ptr;
+						}
+					}
+					pt(ptr) =pt(param);
+				}
 #endif
+				/* modify parameter itself */
-  if (al2(sh(arg1)) <8 ) {
+				if (isenvoff(param)) {
-	arg1 = hold_check(f_offset_pad(f_alignment(ucharsh), arg1) );
+					props(param) = (prop)0;
+					setvis(param);
+				} else {
+					props(param) = (prop)0;
-  }
+				}
+				setparam(param);
-  a = long_to_al(al1(sh(arg1)));
+				setcaonly(param);
+				if (varhack) {
+					setvis(param);
+				}
+				setsh(son(param), ptr_s);
+			} /* if redo... */
-  has_alloca = 1;
+			varhack = 0;
+			/* apply check_id to the parameters */
-  return me_u3(f_pointer(a), arg1, alloca_tag);
+			IGNORE check_id(param, param);
+		} /* for */
-}
+	}
+	if (proc_struct_result != nilexp) {
+		bro(son(proc_struct_result)) = son(res);
+		setfather(proc_struct_result, son(res));
-exp f_local_alloc_check
+		son(res) = proc_struct_result;
+		setfather(res, proc_struct_result);
+	}
+	/* clear this flag to distinguish values created during procedure
-    PROTO_N ( (arg1) )
+	   reading. */
-    PROTO_T ( exp arg1 )
+	in_proc_def = 0;
+	pop_proc_props();
-{
+	if (old_proc_props != (proc_props *)0 || rep_make_proc) {
+		dec *extra_dec = make_extra_dec(make_local_name(), 0, 0, res,
+						f_proc);
-	exp res = f_local_alloc(arg1);
+		exp e = extra_dec->dec_u.dec_val.dec_exp;
-	if (name(res)==alloca_tag) {
+		res = getexp(f_proc, nilexp, 0, e, nilexp, 0, 0, name_tag);
-		set_checkalloc(res);
+		pt(e) = res;
+		no(e) = 1;
+	}
-	return res;
-}
-exp f_local_free
-    PROTO_N ( (a, p) )
-    PROTO_T ( exp a X exp p )
-{
-  if (name(sh(a)) == bothd)
-    { kill_exp(p,p); return a; }
-  if (name(sh(p)) == bothd)
-    { kill_exp(a,a); return p; }
-#if check_shape
-  if (name(sh(a)) != offsethd || name(sh(p)) != ptrhd)
-    failer(CHSH_LOCFREE);
-#endif
-  if (al2(sh(a)) <8 ) {
-	a = hold_check(f_offset_pad(f_alignment(ucharsh), a) );
-  }
-  return me_b3(f_top, p, a, local_free_tag);
-}
-exp f_local_free_all
-    PROTO_Z ()
-{
-  has_setjmp = 1; /* this really means dont inline
-                     and use a stack frame */
-  return getexp(f_top, nilexp, 0, nilexp, nilexp,
-, 0, local_free_all_tag);
-}
-exp f_long_jump
-    PROTO_N ( (arg1, arg2) )
-    PROTO_T ( 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 (name(sh(arg1)) != ptrhd || name(sh(arg2)) != ptrhd)
-    failer(CHSH_LONGJUMP);
-#endif
-  has_setjmp = 1; /* this really means dont inline
-                     and use a stack frame */
-  return me_b3(f_bottom, arg1, arg2, long_jump_tag);
-}
-static int comp_compare
-    PROTO_N ( (a, b) )
-    PROTO_T ( CONST void * a X CONST void * b )
-{
-  return no(*((exp*)a)) - no(*((exp*)b));
-}
-exp f_make_compound
-    PROTO_N ( (arg1, arg2) )
-    PROTO_T ( exp arg1 X exp_list arg2 )
-{
-  exp first = arg2.start;
-  exp r = getexp (f_compound(arg1), nilexp, 0, first,
-                  nilexp, 0, 0, compound_tag);
-  clear_exp_list(arg2);
-  if (arg2.number == 0)
-    {
-      setname (r, clear_tag);
-      return r;
-    }
-#if check_shape
-  {
-    exp t = first;
-    while (1)
-     {
-       if (t != arg2.end && name(sh(bro(t))) == bothd)
-	 return bro(t);
+	return res;
-       if (t == arg2.end ||
-            name(sh(t)) != offsethd ||
-            (!doing_aldefs && al2(sh(t)) < shape_align(sh(bro(t)))))
-           failer(CHSH_MAKECPD);
-       if (bro(t) == arg2.end)
-          break;
-       t = bro(bro(t));
-     };
-  };
-#endif
-  setfather (r, arg2.end);
-  if (!doing_aldefs && arg2.number > 2) {
-    exp * arr = (exp*)xcalloc(arg2.number, sizeof(exp));
-    int i;
-    exp t = son(r);
-    for (i = 0; i < arg2.number; ++i)  {
-      if (!(i & 1) && (no(t) + shape_size(sh(bro(t))) > shape_size(sh(r)) ))
-	failer ("make_compound size exceeded");
-      arr[i] = t;
-      t = bro(t);
-    };
-#ifdef promote_pars
-    for (i = 0; i < arg2.number; i+=2)  {
-	alignment a = al2_of(sh(arr[i]));
-	if (a->al.sh_hd !=0) {
-		shape s = sh(arr[i+1]);
-		if (name(s)>=scharhd && name(s)<=uwordhd) {
-		    shape ns = (is_signed(s))? slongsh:ulongsh;
-		    exp w = hold_check(f_change_variety(f_wrap,ns, arr[i+1]));
-		    arr[i+1] = w;
-		}
-	}
+}
-    }
-#endif
-    qsort(arr, (size_t)(arg2.number/2), (size_t)(2*sizeof(exp)),
-			 comp_compare);
-    son(r) = arr[0];
-    for (i = 1; i < arg2.number; ++i)  {
-      bro(arr[i-1]) = arr[i];
-      clearlast(arr[i-1]);
-    };
-    bro(arr[arg2.number-1]) = r;
-    setlast(arr[arg2.number-1]);
-    xfree((void*)arr);
-  };
-  return r;
-}
-exp f_make_int
-    PROTO_N ( (v, value) )
-    PROTO_T ( variety v X signed_nat value )
-{
-  int n;
-  if (!snat_issmall(value) ||
-	(n = snatint(value), shape_size(v) > 32 &&
-	  (n & (int)0x80000000) != 0))
-    {
-      flpt b;
-      exp res;
-      if (shape_size(v) <= 32) {
-	if (!extra_checks) {
-		flt64 temp;
-		int ov;
-		temp = flt_to_f64(value.signed_nat_val.big_s_nat, 0, &ov);
-		n = temp.small;
-		res = getexp(f_integer(v), nilexp, 0, nilexp, nilexp, 0,
-                			 n, val_tag);
-		return res;
-	}
-	else {
-        	failer(BIG_32);
-       		exit(EXIT_FAILURE);
-	}
-      };
-      if (snat_issmall(value)) {
-	flt64 temp;
-	temp.big = 0;
-	temp.small = (unsigned int)n;
-	b = f64_to_flt(temp, 0);
-      }
-      else { /* copy required since exp may be killed & value may be token res */
-	b = new_flpt();
-        flt_copy (flptnos[value.signed_nat_val.big_s_nat], &flptnos[b]);
-      };
-      if (snatneg(value))
-	  flptnos[b].sign = -1;
-      if (flptnos[b].exp > 3) {
-        failer(BIG_32);
-        exit(EXIT_FAILURE);
-      };
-      res = getexp(f_integer(v), nilexp, 0, nilexp, nilexp, 0,
-                 b, val_tag);
-      setbigval(res);
-      return res;
-    }
-  else {
-    if (snatneg(value))
-      n = -n;
-    return getexp(f_integer(v), nilexp, 0, nilexp, nilexp, 0,
-                 n, val_tag);
-  };
-}
-exp f_make_local_lv
-    PROTO_N ( (lab) )
-    PROTO_T ( label lab )
-{
-  exp l = get_lab(lab);
-  exp res = getexp(f_local_label_value, nilexp, 0, nilexp, l,
-, 0, make_lv_tag);
-  ++no(son(l));
-  set_loaded_lv(l);
-  has_lv = 1;
-  return res;
-}
-exp f_make_nof
-    PROTO_N ( (arg1) )
-    PROTO_T ( exp_list arg1 )
-{
-  exp first = arg1.start;
-  nat t;
-  exp r;
-  clear_exp_list(arg1);
-  nat_issmall(t) = 1;
-  natint(t) = arg1.number;
-  if (arg1.number == 0)  {
-    return getexp(f_nof(t, f_top), nilexp, 0, nilexp, nilexp,
-, 0, nof_tag);
-  };
-  r = getexp (f_nof(t, sh(first)), nilexp, 0, first,
-                  nilexp, 0, 0, nof_tag);
-#if check_shape
-  {exp temp = first;
-   while (1)
-     {
-       if (!eq_shape(sh(temp), sh(first)))
-         failer(CHSH_MAKENOF);
-       if (temp == arg1.end)
-         break;
-       temp = bro(temp);
-     };
-  };
-#endif
-  if (name(sh(first))==bitfhd) {
-	/* make make_nof bitbields into make-compound */
-	int sf = shape_size(sh(first));
-	int snof = shape_size(sh(r));
-	exp *a = &arg1.start;
-	int scs = (((sf-1)&sf)==0)?sf:snof;
-	shape cs = containedshape(scs, 1);
-	int i;
-	shape cpds = f_compound(hold_check(f_offset_pad(f_alignment(cs),
-					f_shape_offset(sh(r)))));
-	exp soff = getexp(f_offset(f_alignment(cpds), f_alignment(sh(first))),
-			  nilexp, 0, nilexp, nilexp, 0, 0, val_tag);
-	for(i=0; i< arg1.number; i++) {
-		bro(soff) = *a;
-		*a = copyexp(soff);
-		a = &bro(bro(*a));
-		no(soff)+= sf;
-	}
-	arg1.number *= 2;
-	return f_make_compound(hold_check(f_shape_offset(cpds)), arg1);
-  }
-  setfather (r, arg1.end);
-  return r;
-}
-exp f_make_nof_int
+procprops crt_procprops;
+void
-    PROTO_N ( (v, s) )
+start_make_general_proc(shape result_shape, procprops prcprops,
-    PROTO_T ( variety v X string s )
+			tagshacc_list caller_intro, tagshacc_list callee_intro)
 {
+	/* initialise global flags which are used at the end of the
+	   reading process in f_make_proc */
+	push_proc_props();
+	proc_struct_result = nilexp;
-   shape sha;
+	has_alloca = 0;
+	proc_is_recursive = 0;
-   exp res;
+	uses_crt_env = 0;
-   nat t;
+	has_setjmp = 0;
+	uses_loc_address = 0;
-   int i;
+	proc_label_count = 0;
+	proc_struct_res = 0;
+	default_freq = 1.0;
+	frame_alignment = f_unite_alignments(f_locals_alignment,
-   shape elem_sh = f_integer(v);
+					     f_callers_alignment((prcprops &
-   int elem_sz = shape_size(elem_sh);
+					     f_var_callers) != 0));
+	frame_alignment =  f_unite_alignments(frame_alignment,
+					      f_callees_alignment((prcprops &
+					      f_var_callees) != 0));
+	proc_externs = 0;
+	/* set this flag to distinguish values created during procedure
-   if (PIC_code)
+	   reading. */
-     proc_externs = 1;
+	in_proc_def = 1;
+	crt_procprops = prcprops;
+	return;
+}
-   nat_issmall(t) = 1;
-   natint(t) = s.number;
-   sha = f_nof(t, elem_sh);
-   res = getexp(sha, nilexp, 0, nilexp, nilexp, (prop)elem_sz,
-, string_tag);
-   if (elem_sz == 64) {
-     int * ss = (int*)xcalloc(s.number, sizeof(int));
-     for (i = 0; i < s.number; ++i) {
-	flt64 x;
-	flpt f;
-	int ov;
-	int sg = is_signed(elem_sh);
-	x.big = 0;
-	switch (s.size) {
-	  case 8:
-	    x.small = (unsigned int)s.ints.chars[i];
-	    break;
-	  case 16:
-	    x.small = (unsigned int)s.ints.shorts[i];
-	    break;
-	  case 32:
-	    x.small = (unsigned int)s.ints.longs[i];
-	    break;
-	  default: {
-	    f = (flpt)s.ints.longs[i];
-	    x = flt_to_f64(f, 0, &ov);
-	    flpt_ret(f);
-	    if (s.size < 64 && sg)
-	      x.big = (x.big << (64-s.size)) >> (64-s.size);
-	  };
-	};
-	ss[i] = f64_to_flt(x, sg);
-     };
-     nostr(res) = (char*) (void*)ss;
-     return res;
-   };
-   switch (s.size)
-    {
-      case 8:
-	{
-	  switch (elem_sz)
-	   {
-		case 8: nostr(res) = (char*)s.ints.chars;
-		        return res;
-		case 16:{short * ss =
-			  (short*)xcalloc(s.number, sizeof(short));
-			 for (i = 0; i < s.number; ++i)
-			   ss[i] = (short)(unsigned char)s.ints.chars[i];
-			 nostr(res) = (char*) (void*)ss;
-			 return res;
-			};
-		case 32:{int * ss =
-			  (int*)xcalloc(s.number, sizeof(int));
-			 for (i = 0; i < s.number; ++i)
-			   ss[i] = (int)(unsigned char)s.ints.chars[i];
-			 nostr(res) = (char*) (void*)ss;
-			 return res;
-			};
-	   };
-	};
+exp
-      case 16:
-	{
-	  switch (elem_sz)
-	   {
-		case 8:{char * ss =
-			  (char*)xcalloc(s.number, sizeof(char));
-			 for (i = 0; i < s.number; ++i)
-			   ss[i] = (char)(unsigned short)s.ints.shorts[i];
-			 nostr(res) = (char*) (void*)ss;
-			 return res;
-			};
-		case 16: nostr(res) = (char*) (void*)s.ints.shorts;
+f_make_general_proc(shape result_shape, procprops prcprops,
-			 return res;
-		case 32:{int * ss =
-			  (int*)xcalloc(s.number, sizeof(int));
-			 for (i = 0; i < s.number; ++i)
-			   ss[i] = (int)(unsigned short)s.ints.shorts[i];
-			 nostr(res) = (char*) (void*)ss;
-			 return res;
-			};
-	   };
-	};
-      case 32:
-	{
-	  switch (elem_sz)
-	   {
-		case 8:{char * ss =
-			  (char*)xcalloc(s.number, sizeof(char));
-			 for (i = 0; i < s.number; ++i)
-			   ss[i] = (char)(unsigned long)s.ints.longs[i];
-			 nostr(res) = (char*) (void*)ss;
-			 return res;
-			};
-		case 16:{short * ss =
-			  (short*)xcalloc(s.number, sizeof(short));
-			 for (i = 0; i < s.number; ++i)
-			   ss[i] = (short)(unsigned long)s.ints.longs[i];
-			 nostr(res) = (char*) (void*)ss;
-			 return res;
-			};
-		case 32: nostr(res) = (char*)(void*)s.ints.longs;
-			 return res;
-	   };
-	};
-    };
-   return res;
-}
-exp f_make_null_local_lv
-    PROTO_Z ()
-{
-  return me_null(f_local_label_value, lv_null, null_tag);
+		    tagshacc_list caller_intro, tagshacc_list callee_intro,
-}
-exp f_make_null_proc
-    PROTO_Z ()
+		    exp body)
-{
-  return me_null(f_proc, proc_null, null_tag);
-}
-exp f_make_null_ptr
-    PROTO_N ( (a) )
-    PROTO_T ( alignment a )
 {
-  return me_null(f_pointer(a), ptr_null, null_tag);
-}
-exp f_maximum
+	exp res;
-    PROTO_N ( (arg1, arg2) )
-    PROTO_T ( 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 (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1)))
-    failer(CHSH_MAX);
-#endif
-#if !has64bits
-	if (name(sh(arg1)) >= s64hd &&
+	if (name(sh(body)) != bothd) {
-		(name(arg1)!=val_tag || name(arg2) != val_tag)) {
-		return TDFcallop3(arg1,arg2,max_tag);
+		failer(CHSH_MAKE_PROC);
+	}
 #endif
+	res = getexp(f_proc, nilexp, 0, caller_intro.id, result_shape, 0, 0,
-  return me_b2(arg1, arg2, max_tag);
+		     general_proc_tag);
-}
+	if (caller_intro.number == 0 && callee_intro.number == 0) {
+		son(res) = body;
-exp f_minimum
+		setlast(body);
-    PROTO_N ( (arg1, arg2) )
+		bro(body) = res;
-    PROTO_T ( exp arg1 X exp arg2 )
+	} else if (callee_intro.number == 0) {
-{
-  if (name(sh(arg1)) == bothd)
+		bro(son(res)) = res;
-    { kill_exp(arg2,arg2); return arg1; }
+		bro(caller_intro.last_def) = body;
-  if (name(sh(arg2)) == bothd)
+		setlast(body);
-    { kill_exp(arg1,arg1); return arg2; }
+		bro(body) = caller_intro.last_id;
-#if check_shape
+	} else {
+		int i;
+		exp z = callee_intro.id;
-  if (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1)))
+		for (i = 0; i < callee_intro.number; i++) {
+			set_callee(z);
-    failer(CHSH_MIN);
+			z = bro(son(z));
-#endif
+		}
+		if (caller_intro.number != 0) {
+			bro(caller_intro.last_def) = callee_intro.id;
+			bro(callee_intro.id) = caller_intro.last_id;	/*???*/
-#if !has64bits
+		} else {
-	if (name(sh(arg1)) >= s64hd &&
+			son(res) = callee_intro.id;
+		}
-		(name(arg1)!=val_tag || name(arg2) != val_tag)) {
+		bro(son(res)) = res;
-		error_treatment ov_err;
+		bro(callee_intro.last_def) = body;
-		ov_err = f_wrap;
+		setlast(body);
-		return TDFcallop2(ov_err,arg1,arg2,min_tag);
+		bro(body) = callee_intro.last_id;
+	}
-#endif
-  return me_b2(arg1, arg2, min_tag);
-}
-static int in_initial_value;
-static void push_proc_props
-    PROTO_Z ()
-{
-  proc_props * temp = (proc_props*)xcalloc(1, sizeof(proc_props));
-  temp->proc_struct_result = proc_struct_result;
-  temp->has_alloca = has_alloca;
-  temp->proc_is_recursive = proc_is_recursive;
-  temp->uses_crt_env = uses_crt_env;
-  temp->has_setjmp = has_setjmp;
-  temp->uses_loc_address = uses_loc_address;
-  temp->proc_label_count = proc_label_count;
-  temp->proc_struct_res = proc_struct_res;
-  temp->default_freq = default_freq;
-  temp->proc_externs = proc_externs;
-  temp->in_proc_def = in_proc_def;
-  temp->pushed = old_proc_props;
-  temp->rep_make_proc = rep_make_proc;
-  temp->frame_alignment = frame_alignment;
-  temp->in_initial_value = in_initial_value;
-  old_proc_props = temp;
-  return;
-}
-static void pop_proc_props
-    PROTO_Z ()
-{
-  proc_props * temp = old_proc_props;
-  proc_struct_result = temp->proc_struct_result;
-  has_alloca = temp->has_alloca;
-  proc_is_recursive =temp-> proc_is_recursive;
-  uses_crt_env = temp->uses_crt_env;
-  has_setjmp = temp->has_setjmp;
-  uses_loc_address = temp->uses_loc_address;
-  proc_label_count = temp->proc_label_count;
-  proc_struct_res = temp->proc_struct_res;
-  default_freq = temp->default_freq;
-  proc_externs = temp->proc_externs;
-  in_proc_def = temp->in_proc_def;
-  old_proc_props = temp->pushed;
-  rep_make_proc = temp->rep_make_proc;
-  frame_alignment = temp->frame_alignment;
-  in_initial_value = temp->in_initial_value;
-  if (temp != &initial_value_pp) xfree((void*)temp);
-  return;
-}
-void start_make_proc
-    PROTO_N ( (result_shape, params_intro, vartag) )
-    PROTO_T ( shape result_shape X tagshacc_list params_intro X tagacc_option vartag )
-{
-    /* initialise global flags which are used at the end of the
-       reading process in f_make_proc */
-  UNUSED(result_shape); UNUSED(params_intro);
-  push_proc_props();
-  proc_struct_result = nilexp;
-  has_alloca = 0;
-  proc_is_recursive = 0;
-  uses_crt_env = 0;
-  has_setjmp = 0;
-  uses_loc_address = 0;
-  proc_label_count = 0;
-  proc_struct_res = 0;
-  default_freq = 1.0;
-  proc_externs = 0;
-  in_initial_value = 0;
-  frame_alignment = f_unite_alignments(f_locals_alignment, var_callers_alignment);
-  if (vartag.present) {
-    shape sha = getshape(0, const_al1, const_al1,
-			 VAR_PARAM_ALIGN, 0, cpdhd);
-    exp d = getexp(sha, nilexp, 0, nilexp, nilexp, 0, 0, clear_tag);
-    exp i = getexp(f_bottom, nilexp, 1, d, nilexp, 0, 0, ident_tag);
-    setvis(i);
-    setvar(i);
-    setparam(i);
-    set_tag(vartag.val.tg, i);
-   };
-    /* set this flag to distinguish values created during procedure
-       reading.
-    */
-  in_proc_def = 1;
-  return;
-}
-exp f_make_proc
-    PROTO_N ( (result_shape, params_intro, vartag, body) )
-    PROTO_T ( shape result_shape X tagshacc_list params_intro X tagacc_option vartag X exp body )
-{
-  exp res;
-  int varhack = 0;
-#if ishppa
-  exp t,id,ptr;
-#endif
-#if check_shape
-  if (name(sh(body)) != bothd)
-    failer(CHSH_MAKE_PROC);
-#endif
-  if (vartag.present)  {
-    exp i = get_tag(vartag.val.tg);
-    if (params_intro.id == nilexp)
-      params_intro.id = i;
-    else
-      bro(params_intro.last_def) = i;
-    bro(i) = params_intro.last_id;
-    params_intro.last_def = son(i);
-    params_intro.last_id = i;
-    setvis(i);
-    ++params_intro.number;
-    varhack = 1;
-  };
-  res = getexp(f_proc, nilexp, 0, params_intro.id, result_shape,
-, 0, proc_tag);
-  if (params_intro.number == 0)
-   {
-     son(res) = body;
-     setlast(body);
-     bro(body) = res;
-   }
-  else
-   {
-     bro(son(res)) = res;
-     bro(params_intro.last_def) = body;
-     setlast(body);
-     bro(body) = params_intro.last_id;
 #ifdef promote_pars
-  	promote_formals(son(res));
+	promote_formals(son(res));
 #endif
-   };
-     /* set the properties of the procedure construction from the
+	/* set the properties of the procedure construction from the
-        global values accumulated during reading.
+	   global values accumulated during reading.
-        WE OUGHT TO POP THE OLD VALUES.
+	   WE OUGHT TO POP THE OLD VALUES.
-     */
+	 */
-  if (has_alloca)
+	if (has_alloca) {
-    set_proc_has_alloca(res);
+		set_proc_has_alloca(res);
+	}
-  if (proc_is_recursive)
+	if (proc_is_recursive) {
-    setrecursive(res);
+		setrecursive(res);
+	}
-  if (has_lv)
+	if (has_lv) {
-    set_proc_has_lv(res);
+		set_proc_has_lv(res);
-  if (uses_crt_env)
-    set_proc_uses_crt_env(res);
-  if (has_setjmp)
-    set_proc_has_setjmp(res);
-  if (uses_loc_address)
-    set_loc_address(res);
-  if (proc_struct_res)
-    set_struct_res(res);
-  if (proc_externs)
-    set_proc_uses_external(res);
-    /* apply check_id to the parameters */
-  if (params_intro.number !=0)
-  {
-    exp param;
-    for (param = params_intro.last_id; param != res; param = bro(param))
-    {
-      if (redo_structparams  &&
-#if ishppa
-	 (varhack || ((shape_size(sh(son(param)))>64) &&
-                      (name(sh(son(param))) == cpdhd ||name(sh(son(param))) == nofhd ||
-		       name(sh(son(param))) == doublehd))))
-#else
-#if issparc
-	(varhack || sparccpd(sh(son(param))) ))
-#else
-		(varhack || name(sh(son(param))) == cpdhd||name(sh(son(param))) == nofhd ||
-		 name(sh(son(param))) == doublehd))
-#endif
-#endif
-      {
-        /*
-         * Param IS struct/union-by-value.  Incoming acutal parameter
-         * will have been changed to be ptr-to expected value (see
-         * f_apply_proc()), so adjust usage in body.
-         */
-        exp use;                /* use of ident in pt() chain */
-        exp prev;               /* previous use in pt() chain */
-	exp eo = nilexp;
-        shape ptr_s = f_pointer(f_alignment(sh(son(param))));
-#if ishppa
-        /* modify parameter itself */
-        if (!varhack)
-	{
+	}
-	  exp obtain_param;
-	  exp assign;
-          shape sha=sh(son(param));
-          t=me_obtain(param);
-          if (uses_crt_env)
+	if (uses_crt_env) {
-	  {
-	    eo = f_env_offset(frame_alignment,f_parameter_alignment(ptr_s),brog(param));
-            obtain_param = f_add_to_ptr(f_current_env(), eo);
-	  }
-          id=me_startid(f_top,me_u3(sha,t,cont_tag),1);
-          ptr=me_startid(f_top,me_obtain(id),0);
-          if (uses_crt_env)
+		set_proc_uses_crt_env(res);
-	  {
- 	    assign = f_assign(obtain_param, me_obtain(id));
-	    body = f_sequence(add_exp_list(new_exp_list(1),assign, 0), body);
-	  }
-          clearlast(son(ptr));
-          bro(son(ptr))=body;
-          setlast(body);
-          bro(body)=ptr;
-          sh(ptr)=sh(body);
-          body=id;
-          clearlast(son(id));
-          bro(son(id)) = ptr;
-          setlast(ptr);
-          bro(ptr) = id;
-          sh(id) = sh(ptr);
-          bro(params_intro.last_def) = body;
-          setlast(body);
-          bro(body) = param;
 	}
-#endif
-        /* visit each use of the parameter modifying appropriately*/
-        for (prev = param, use = pt(prev);
-             use != nilexp;
-             prev = use, use = pt(prev))
-	if (!uses_crt_env || (uses_crt_env && use != eo))
-        {
-          if (!isvar(param))    /* add cont */
-          {
-            exp new_use =
-                getexp(ptr_s,
-                       use, (bool)1, son(use), pt(use), props(use), 0, name_tag);
-            son(use) = new_use;
-            pt(prev) = new_use;
-            pt(use) = nilexp;
-            props(use) = (prop)0;
-            setname(use, cont_tag); /* retain same no and sh */
-            use = new_use;
-          }
-          if (no(use) > 0)      /* add reff */
-          {
-            exp new_use =
-                getexp(ptr_s,
-                       use, (bool)1, son(use), pt(use), props(use), 0, name_tag);
-            son(use) = new_use;
-            pt(prev) = new_use;
-            pt(use) = nilexp;
-            props(use) = (prop)0;
-            setname(use, reff_tag); /* retain same no and sh */
-            use = new_use;
-          }
-        } /* for */
-#if ishppa
-	if (!varhack)
+	if (has_setjmp) {
-	{
-          /* Change all but ptr's references to param to references to ptr */
-          for (use = pt(param); use != nilexp; use = pt(use))
-	  {
-            if ((son(use)==param) && (use!=son(son(id)))
-                && (!uses_crt_env || (uses_crt_env && use != eo )))
-               son(use)=ptr;
-          }
-          pt(ptr)=pt(param);
+		set_proc_has_setjmp(res);
+	}
+	if (uses_loc_address) {
-#endif
+		set_loc_address(res);
+	}
-        /* modify parameter itself */
+	if (proc_struct_res) {
-	if (isenvoff(param)) {
+		set_struct_res(res);
+	}
-        	props(param) = (prop)0;
+	if (proc_externs) {
-		setvis(param);
+		set_proc_uses_external(res);
+	}
-exp find_caller_id
+exp
-    PROTO_N ( (n, p) )
-    PROTO_T ( int n X exp p )
+find_caller_id(int n, exp p)
+{
 	while (name(p) == ident_tag) {
-		if (name(son(p)) == caller_name_tag && no(son(p))==n) {
+		if (name(son(p)) == caller_name_tag && no(son(p)) ==n) {
 			return p;
+		}
 		p = bro(son(p));
+	}
 	return nilexp;
+}
-void start_apply_general_proc
+void
-    PROTO_N ( (result_shape, prcprops, p, caller_params_intro, callee_params) )
-    PROTO_T ( shape result_shape X procprops_option prcprops X exp p X
+start_apply_general_proc(shape result_shape, procprops_option prcprops, exp p,
-	      otagexp_list caller_params_intro X callees callee_params )
+			 otagexp_list caller_params_intro,
+			 callees callee_params)
 {
-  return;
+	return;
 }
-exp f_apply_general_proc
+exp
-    PROTO_N ( (result_shape, prcprops, p, caller_pars, callee_pars, postlude) )
-    PROTO_T ( shape result_shape X procprops prcprops X exp p X
+f_apply_general_proc(shape result_shape, procprops prcprops, exp p,
-	      otagexp_list caller_pars X callees callee_pars X exp postlude )
+		     otagexp_list caller_pars, callees callee_pars,
+		     exp postlude)
+{
-	exp res = getexp(result_shape, nilexp, 0, p, nilexp,
+	exp res = getexp(result_shape, nilexp, 0, p, nilexp, 0, 0,
-, 0, apply_general_tag);
+			 apply_general_tag);
-        exp r_p;
+	exp r_p;
-        exp redos = nilexp;
+	exp redos = nilexp;
 	exp last_redo;
-        has_alloca = 1;
+	has_alloca = 1;
 	if (name(callee_pars) == same_callees_tag) {
 		/* it's a constant */
 		callee_pars = copy(callee_pars);
 	}
-	if (redo_structparams){
+	if (redo_structparams) {
-	    int i;
+		int i;
-	    exp * plce = &caller_pars.start;
+		exp *plce = &caller_pars.start;
-	    for(i=0; i< caller_pars.number; i++) {
+		for (i = 0; i < caller_pars.number; i++) {
-	        exp ote = *plce;
+			exp ote = *plce;
-		exp param = (name(ote)==caller_tag)?son(ote):ote;
+			exp param = (name(ote) == caller_tag) ? son(ote) : ote;
+			if ((name(sh(param)) == cpdhd ||
-		if ((name(sh(param)) == cpdhd || name(sh(param)) == nofhd ||
+			     name(sh(param)) == nofhd ||
-			 name(sh(param)) == doublehd)
+			     name(sh(param)) == doublehd)
 #if issparc
-		|| sparccpd(sh(param))
+			    || sparccpd(sh(param))
 #endif
 #if ishppa
-		&& shape_size(sh(param))>64
+			    && shape_size(sh(param)) >64
 #endif
+			    ) {
-		) { /* make copy of par and use ptr as par */
+				/* make copy of par and use ptr as par */
+				shape nshape =
-		    shape nshape = f_pointer(f_alignment(sh(param)));
+				    f_pointer(f_alignment(sh(param)));
-		    exp rd = me_startid(nshape, param, 1);
+				exp rd = me_startid(nshape, param, 1);
-		    exp npar = me_obtain(rd);
+				exp npar = me_obtain(rd);
-		    exp id;
+				exp id;
-		    if (name(ote)==caller_tag &&
+				if (name(ote) ==caller_tag &&
-			(id = find_caller_id(i, caller_pars.id)) != nilexp) {
+				    (id = find_caller_id(i, caller_pars.id)) !=
+				    nilexp) {
-			exp p = pt(id);
+					exp p = pt(id);
-			son(ote) = npar;
+					son(ote) = npar;
+					bro(npar) = ote;
-			bro(npar)= ote; setlast(npar);
+					setlast(npar);
-			sh(son(id)) = sh(npar);
+					sh(son(id)) = sh(npar);
+					while(p != nilexp) {
-			while(p != nilexp) { /* replaces uses in postlude */
+						/* replaces uses in postlude */
-			    exp bp = bro(p);
+						exp bp = bro(p);
-			    int l = last(p);
+						int l = last(p);
-			    exp np = pt(p);
+						exp np = pt(p);
-			    exp * pos = refto(father(p), p);
+						exp *pos = refto(father(p), p);
-			    exp c;
+						exp c;
-			    sh(p) = nshape;
+						sh(p) = nshape;
-			    c = f_contents(sh(ote), p);
+						c = f_contents(sh(ote), p);
+						if (l) {
+							setlast(c);
+						} else {
-			    if (l) { setlast(c); } else {clearlast(c); }
+							clearlast(c);
+						}
-			    bro(c) = bp;
+						bro(c) = bp;
-			    *pos = c;
+						*pos = c;
-			    p = np;
+						p = np;
-			}
+					}
-			sh(ote) = nshape;
+					sh(ote) = nshape;
-			plce = &bro(ote);
+					plce = &bro(ote);
-		     }
+				} else {
-		     else {
+					if (last(ote)) {
-		        if (last(ote)) { setlast(npar); }
+						setlast(npar);
+					}
-		     	bro(npar) = bro(ote);
+					bro(npar) = bro(ote);
-			if (ote == caller_pars.end) caller_pars.end = npar;
+					if (ote == caller_pars.end) {
+						caller_pars.end = npar;
+					}
-			*plce = npar;
+					*plce = npar;
-			plce = &bro(npar);
+					plce = &bro(npar);
-		     }
+				}
-		     bro(son(rd)) = redos; clearlast(son(rd));
+				bro(son(rd)) = redos;
+				clearlast(son(rd));
-		     if (redos != nilexp) {
+				if (redos != nilexp) {
-		     	bro(redos) = rd; setlast(redos);
+					bro(redos) = rd;
+					setlast(redos);
-		     }
+				} else {
-		     else last_redo = rd;
+					last_redo = rd;
+				}
-		     redos = rd;
+				redos = rd;
-		 }
+			} else {
-		 else {plce = &bro(ote);}
+				plce = &bro(ote);}
-	    }
+		}
 	}
-        if (caller_pars.id != nilexp) {
+	if (caller_pars.id != nilexp) {
-        	exp a = caller_pars.id;
+		exp a = caller_pars.id;
-        	while (bro(son(a)) != nilexp) { a = bro(son(a)); }
+		while (bro(son(a)) != nilexp) {
+			a = bro(son(a));
+		}
-        	bro(son(a)) = postlude;
+		bro(son(a)) = postlude;
-        	setfather(a,postlude);
+		setfather(a, postlude);
-        	postlude = caller_pars.id;
+		postlude = caller_pars.id;
-        }
+	}
-        setfather(res, postlude);
+	setfather(res, postlude);
-        bro(callee_pars) = postlude; clearlast(callee_pars);
+	bro(callee_pars) = postlude;
+	clearlast(callee_pars);
-        props(callee_pars) = prcprops;
+	props(callee_pars) = prcprops;
-        r_p = getexp(f_top, callee_pars, 0, caller_pars.start, nilexp, prcprops,
+	r_p = getexp(f_top, callee_pars, 0, caller_pars.start, nilexp, prcprops,
-        		caller_pars.number, 0);
+		     caller_pars.number, 0);
+	if (caller_pars.number != 0) {
-        if (caller_pars.number !=0) { setfather(r_p,caller_pars.end); }
+		setfather(r_p, caller_pars.end);
+	}
-        bro(p) = r_p; clearlast(p);
+	bro(p) = r_p; clearlast(p);
 #ifdef promote_pars
-    {	int i;
+	{	int i;
-	exp ote = caller_pars.start;
+		exp ote = caller_pars.start;
-	for (i = 0; i< caller_pars.number; i++) {
+		for (i = 0; i < caller_pars.number; i++) {
-	    shape s = sh(ote);
+			shape s = sh(ote);
-	    if (name(s)>=scharhd && name(s)<=uwordhd) {
+			if (name(s) >= scharhd && name(s) <= uwordhd) {
-	        shape ns = (is_signed(s))? slongsh:ulongsh;
+				shape ns = (is_signed(s)) ? slongsh : ulongsh;
-		exp par = (name(ote)==caller_tag)?son(ote):ote;
+				exp par = (name(ote) == caller_tag) ?
+				    son(ote) : ote;
-		exp next = bro(ote);
+				exp next = bro(ote);
-		exp id;
+				exp id;
-		int l = last(ote);
+				int l = last(ote);
-	        exp w = hold_check(f_change_variety(f_wrap,ns, copy(par)));
+				exp w = hold_check(f_change_variety(f_wrap, ns,
+								    copy(par)));
-		if (name(ote)==caller_tag) sh(ote)=ns;
+				if (name(ote) == caller_tag) {
+					sh(ote) = ns;
+				}
-	        replace(par, w, nilexp);
+				replace(par, w, nilexp);
-	        kill_exp(par, nilexp);
+				kill_exp(par, nilexp);
-	    	if (name(ote) == caller_tag &&
+				if (name(ote) == caller_tag &&
-			(id = find_caller_id(i, postlude)) != nilexp) {
+				    (id = find_caller_id(i, postlude)) !=
+				    nilexp) {
-		    exp p = pt(id);
+					exp p = pt(id);
-		    sh(son(id))=ns;
+					sh(son(id)) = ns;
+					while(p != nilexp) {
-		    while(p != nilexp) { /* replaces uses in postlude */
+						/* replaces uses in postlude */
-			exp nextp = pt(p);
+						exp nextp = pt(p);
-			sh(p) = ns;
+						sh(p) = ns;
-		    	w = f_change_variety(f_wrap, s, copy(p));
+						w = f_change_variety(f_wrap, s,
+								     copy(p));
-			replace(p, w, nilexp);
+						replace(p, w, nilexp);
-			kill_exp(p, nilexp);
+						kill_exp(p, nilexp);
-			p = nextp;
+						p = nextp;
-		    }
+					}
+				}
+				if (l) {
+					break;
+				}
+				ote = next;
+			} else ote = bro(ote);
+		}
-		if (l) break;
-		ote = next;
-	    }
-	    else ote = bro(ote);
+	}
-    }
 #endif
-  if (redo_structfns && !reg_result(result_shape))
+	if (redo_structfns && !reg_result(result_shape))
-   {
+	{
-     /* replace f(x) by {var r; f(r, x); cont(r)} */
+		/* replace f(x) by {var r; f(r, x); cont(r)} */
-     exp init, vardec, cont, contname, seq, app, appname, tmp;
+		exp init, vardec, cont, contname, seq, app, appname, tmp;
-     exp_list list;
+		exp_list list;
-     shape ptr_res_shape = f_pointer(f_alignment(result_shape));
+		shape ptr_res_shape = f_pointer(f_alignment(result_shape));
-     init = getexp(result_shape, nilexp, 0, nilexp, nilexp,
+		init = getexp(result_shape, nilexp, 0, nilexp, nilexp, 0, 0,
-, 0, clear_tag);
+			      clear_tag);
-     vardec = getexp(result_shape, nilexp, 0, init, nilexp,
+		vardec = getexp(result_shape, nilexp, 0, init, nilexp, 0, 1,
-, 1, ident_tag);
+				ident_tag);
-     setvar(vardec);
+		setvar(vardec);
-     contname = getexp(ptr_res_shape, nilexp, 0,
+		contname = getexp(ptr_res_shape, nilexp, 0, vardec, nilexp, 0,
-                           vardec, nilexp, 0, 0, name_tag);
+, name_tag);
-     pt(vardec) = contname;
+		pt(vardec) = contname;
-     cont = f_contents(result_shape, contname);
+		cont = f_contents(result_shape, contname);
-     appname = getexp(ptr_res_shape, son(r_p), 0,
+		appname = getexp(ptr_res_shape, son(r_p), 0, vardec, contname,
-                        vardec, contname, 0, 0, name_tag);
+, 0, name_tag);
-     if(no(r_p)++ == 0) {
+		if (no(r_p)++ == 0) {
-     		setfather(r_p, appname);
+			setfather(r_p, appname);
-     }
+		}
-     ++no(vardec);
+		++no(vardec);
-     pt(vardec) = appname;
+		pt(vardec) = appname;
-     app = getexp(f_top, nilexp, 0, son(res), nilexp, 0, 32,
+		app = getexp(f_top, nilexp, 0, son(res), nilexp, 0, 32,
-                    apply_general_tag);
+			     apply_general_tag);
-     son(r_p) = appname;
+		son(r_p) = appname;
+		tmp = postlude;
+		while (name(tmp) ==ident_tag &&
+		       name(son(tmp)) == caller_name_tag) {
+			no(son(tmp))++;
+			tmp = bro(son(tmp));
+		}
+		bro(postlude) = app;
+		list.number = 1;
+		list.start = app;
+		list.end = app;
+		seq = f_sequence(list, cont);
+		bro(init) = seq;
+		setfather(vardec, seq);
+		retcell(res);
+		res = vardec;
+	}
-     tmp = postlude;
+	if (redos != nilexp) {
-     while(name(tmp)==ident_tag && name(son(tmp))==caller_name_tag) {
+		/* put in decs given by redo_structparams */
-		no(son(tmp))++;
+		bro(son(last_redo)) = res;
-		tmp = bro(son(tmp));
+		clearlast(son(last_redo));
+		bro(res) = last_redo;
+		setlast(res);
+		res = redos;
-     }
+	}
+	return res;
+}
-     bro(postlude) = app;
-     list.number = 1;
-     list.start = app;
-     list.end = app;
-     seq = f_sequence(list, cont);
-     bro(init) = seq;
-     setfather(vardec, seq);
-     retcell(res);
-     res = vardec;
-   };
-   if (redos != nilexp) { /* put in decs given by redo_structparams */
-   	bro(son(last_redo)) = res; clearlast(son(last_redo));
-	bro(res) = last_redo; setlast(res);
-	res = redos;
-   }
+exp
-   return res;
-}
-exp f_tail_call
-    PROTO_N ( (prcprops,p,callee_params) )
-    PROTO_T ( procprops prcprops X exp p X callees callee_params )
+f_tail_call(procprops prcprops, exp p, callees callee_params)
+{
-	exp res = getexp(f_bottom,nilexp, 0, p, nilexp, 0,0,
+	exp res = getexp(f_bottom, nilexp, 0, p, nilexp, 0, 0, tail_call_tag);
-			tail_call_tag);
 	exp e_p;
 	if (name(callee_params) == same_callees_tag) {
 		/* it's a constant */
 		callee_params = copy(callee_params);
+	}
-	e_p = getexp(f_top, res, 1, callee_params, nilexp, prcprops,
+	e_p = getexp(f_top, res, 1, callee_params, nilexp, prcprops, 0, 0);
-, 0);
-	has_setjmp = 1; /* stop inlining ! */
+	has_setjmp = 1; /* stop inlining! */
 	has_alloca = 1; /* make sure has fp */
 	props(callee_params) = prcprops;
-	bro(p) = callee_params; 	clearlast(p);
+	bro(p) = callee_params;
+	clearlast(p);
 	setfather(res, callee_params);
 	return res;
+}
+exp
-exp f_untidy_return
+f_untidy_return(exp arg)
-    PROTO_N ( (arg) )
-    PROTO_T ( exp arg )
+{
-   	exp res = getexp(f_bottom, nilexp, 0, arg, nilexp, 0, 0,
+	exp res = getexp(f_bottom, nilexp, 0, arg, nilexp, 0, 0,
-   				untidy_return_tag);
+			 untidy_return_tag);
-   	setfather(res,arg);
+	setfather(res, arg);
 	has_setjmp = 1;
-   	return res;
+	return res;
- }
+}
-alignment f_parameter_align
+alignment
-    PROTO_N ( (a) )
-    PROTO_T ( alignment a )
+f_parameter_align(alignment a)
 {
-	return( f_var_param_alignment);
+	return (f_var_param_alignment);
-}
-exp f_set_stack_limit
-    PROTO_N ( (flim) )
-    PROTO_T ( exp flim )
-{
-   	return me_u3(f_top, flim, set_stack_limit_tag);
+}
+exp
-exp f_give_stack_limit
+f_set_stack_limit(exp flim)
+{
-    PROTO_N ( (frame_al) )
+   	return me_u3(f_top, flim, set_stack_limit_tag);
+}
+exp
-    PROTO_T ( alignment frame_al )
+f_give_stack_limit(alignment frame_al)
+{
    	exp res = getexp(f_pointer(frame_al), nilexp, 0, nilexp, nilexp, 0, 0,
-   				give_stack_limit_tag);
+			 give_stack_limit_tag);
    	return res;
 }
-exp f_make_stack_limit
+exp
-    PROTO_N ( (stack_base, frame_size, alloca_size) )
-    PROTO_T ( exp stack_base X exp frame_size X exp alloca_size )
+f_make_stack_limit(exp stack_base, exp frame_size, exp alloca_size)
+{
 	exp sz;
-	frame_size = hold_check(f_offset_pad(al1_of(sh(alloca_size)), frame_size) );
+	frame_size = hold_check(f_offset_pad(al1_of(sh(alloca_size)),
+					     frame_size));
-	alloca_size = hold_check(f_offset_pad(f_alignment(ucharsh), alloca_size) );
+	alloca_size = hold_check(f_offset_pad(f_alignment(ucharsh),
+					      alloca_size));
 	sz = hold_check(f_offset_add(frame_size, alloca_size));
 	return me_b2(stack_base, sz, make_stack_limit_tag);
+}
-exp f_env_size
+exp
-    PROTO_N ( (proctag) )
-    PROTO_T ( tag proctag )
+f_env_size(tag proctag)
+{
-  	exp res = getexp(f_offset(f_locals_alignment,f_locals_alignment ), nilexp, 0,
+  	exp res = getexp(f_offset(f_locals_alignment, f_locals_alignment),
-  			 f_obtain_tag(proctag), nilexp, 0, 0, env_size_tag);
+			 nilexp, 0, f_obtain_tag(proctag), nilexp, 0, 0,
+			 env_size_tag);
-  	bro(son(res))=res; setlast(son(res));
+  	bro(son(res)) = res;
+	setlast(son(res));
   	return res;
+}
-nat f_error_val
+nat
-    PROTO_N ( (ec) )
-    PROTO_T ( error_code ec )
+f_error_val(error_code ec)
+{
 	nat res;
 	nat_issmall(res) =1;
 	natint(res) = ec;
 	return res;
 }
-exp f_make_top
-    PROTO_Z ()
-{
-  return getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, top_tag);
-}
+exp
-exp f_make_value
+f_make_top(void)
-    PROTO_N ( (s) )
-    PROTO_T ( shape s )
-{
-  return me_l1(s, clear_tag);
-}
-exp f_minus
-    PROTO_N ( (ov_err, arg1, arg2) )
-    PROTO_T ( error_treatment ov_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; }
+	return getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, top_tag);
+}
-#if check_shape
-  if (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1)))
-    failer(CHSH_MINUS);
-#endif
-#if !has64bits
-	if (name(sh(arg1)) >= s64hd &&
-		(name(arg1)!=val_tag || name(arg2) != val_tag|| ov_err.err_code > 2)) {
-		return TDFcallop2(ov_err,arg1,arg2,minus_tag);
-	}
+exp
-#endif
-  return me_b1(ov_err, arg1, arg2, minus_tag);
-}
-exp f_move_some
+f_make_value(shape s)
-    PROTO_N ( (md, arg1, arg2, arg3) )
-    PROTO_T ( transfer_mode md X exp arg1 X exp arg2 X exp arg3 )
+{
-  exp r = getexp(f_top, nilexp, 0, arg1, nilexp, 0, 0,
-                  movecont_tag);
-  if (name(sh(arg1)) == bothd)
-    { kill_exp(arg2,arg2); kill_exp(arg3,arg3); return arg1; }
-  if (name(sh(arg2)) == bothd)
-    { kill_exp(arg1,arg1); kill_exp(arg3,arg3); return arg2; }
-  if (name(sh(arg3)) == bothd)
-    { kill_exp(arg1,arg1); kill_exp(arg2,arg2); return arg3; }
-#if check_shape
-  if (name(sh(arg1)) != ptrhd || name(sh(arg2)) != ptrhd ||
-       name(sh(arg3)) != offsethd ||
-       al1(sh(arg1)) < al1(sh(arg3)) || al1(sh(arg2)) < al1(sh(arg3)))
-    failer(CHSH_MOVESOME);
-#endif
-#ifdef no_trap_on_nil_contents
-	if ((md & f_trap_on_nil) != 0) {
-		exp d2 = me_startid(f_top, arg2, 0);
-                exp d1 = me_startid(f_top, 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_list el;
-		exp test2 = me_q1(no_nat_option, f_not_equal, &lb, me_obtain(d2),
-				f_make_null_ptr(al1_of(sh(arg2))), test_tag);
-                exp test1 = me_q1(no_nat_option, f_not_equal, &lb, me_obtain(d1),
-                                  f_make_null_ptr(al1_of(sh(arg1))), test_tag);
-		exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp,
-, f_nil_access, trap_tag);
-		md &= ~f_trap_on_nil;
-     		el = new_exp_list(2);
-     		el = add_exp_list(el, test1, 1);
-                el = add_exp_list(el, test2, 2);
-     		return me_complete_id(d2,me_complete_id(d1,
-		   f_conditional(&lb, f_sequence(el,f_move_some(md, me_obtain(d1), me_obtain(d2), arg3) ),trp
-				) ));
-   	};
-#endif
-  if (!(md & f_overlap) && name(arg3) == val_tag && al2(sh(arg3)) > 1) {
-    exp c = f_contents(f_compound(arg3), arg1);
-    return f_assign(arg2, c);
+	return me_l1(s, clear_tag);
-  };
-  if (al2(sh(arg3)) < 8) {
-	arg3 = hold_check(f_offset_pad(f_alignment(ucharsh), arg3));
-  }
-  if (!(md & f_overlap))
-    setnooverlap(r);
-  clearlast(arg1);
-  setbro(arg1, arg2);
-  clearlast(arg2);
-  setbro(arg2, arg3);
-  setfather(r, arg3);
-  return r;
+}
-exp f_mult
+exp
-    PROTO_N ( (ov_err, arg1, arg2) )
-    PROTO_T ( error_treatment ov_err X exp arg1 X exp arg2 )
+f_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 (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1)))
+	if (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1))) {
-    failer(CHSH_MULT);
+		failer(CHSH_MINUS);
+	}
 #endif
 #if !has64bits
 	if (name(sh(arg1)) >= s64hd &&
-		(name(arg1)!=val_tag || name(arg2) != val_tag|| ov_err.err_code > 2)) {
+	    (name(arg1) != val_tag || name(arg2) != val_tag ||
+	     ov_err.err_code > 2)) {
-		return TDFcallop2(ov_err,arg1,arg2,mult_tag);
+		return TDFcallop2(ov_err, arg1, arg2, minus_tag);
 	}
 #endif
+	return me_b1(ov_err, arg1, arg2, minus_tag);
+}
+exp
+f_move_some(transfer_mode md, exp arg1, exp arg2, exp arg3)
+{
+	exp r = getexp(f_top, nilexp, 0, arg1, nilexp, 0, 0, movecont_tag);
+	if (name(sh(arg1)) == bothd) {
+		kill_exp(arg2, arg2);
+		kill_exp(arg3, arg3);
+		return arg1;
+	}
+	if (name(sh(arg2)) == bothd) {
+		kill_exp(arg1, arg1);
+		kill_exp(arg3, arg3);
+		return arg2;
+	}
+	if (name(sh(arg3)) == bothd) {
+		kill_exp(arg1, arg1);
+		kill_exp(arg2, arg2);
+		return arg3;
+	}
+#if check_shape
+	if (name(sh(arg1)) != ptrhd || name(sh(arg2)) != ptrhd ||
+	    name(sh(arg3)) != offsethd || al1(sh(arg1)) < al1(sh(arg3)) ||
+	    al1(sh(arg2)) < al1(sh(arg3))) {
+		failer(CHSH_MOVESOME);
+	}
+#endif
+#ifdef no_trap_on_nil_contents
+	if ((md & f_trap_on_nil) != 0) {
+		exp d2 = me_startid(f_top, arg2, 0);
+		exp d1 = me_startid(f_top, 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_list el;
+		exp test2 = me_q1(no_nat_option, f_not_equal, &lb,
+				  me_obtain(d2),
-  return me_b1(ov_err, arg1, arg2, mult_tag);
+				  f_make_null_ptr(al1_of(sh(arg2))), test_tag);
+		exp test1 = me_q1(no_nat_option, f_not_equal, &lb,
+				  me_obtain(d1), f_make_null_ptr(al1_of(
+				  sh(arg1))), test_tag);
+		exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,
+				 f_nil_access, trap_tag);
+		md &= ~f_trap_on_nil;
+		el = new_exp_list(2);
+		el = add_exp_list(el, test1, 1);
+		el = add_exp_list(el, test2, 2);
+		return me_complete_id(d2, me_complete_id(d1, f_conditional(&lb,
+		    f_sequence(el, f_move_some(md, me_obtain(d1), me_obtain(d2),
+					       arg3)), trp)));
+	}
+#endif
+	if (!(md & f_overlap) && name(arg3) == val_tag && al2(sh(arg3)) > 1) {
+		exp c = f_contents(f_compound(arg3), arg1);
+		return f_assign(arg2, c);
+	}
+	if (al2(sh(arg3)) < 8) {
+		arg3 = hold_check(f_offset_pad(f_alignment(ucharsh), arg3));
+	}
+	if (!(md & f_overlap)) {
+		setnooverlap(r);
+	}
+	clearlast(arg1);
+	setbro(arg1, arg2);
+	clearlast(arg2);
+	setbro(arg2, arg3);
+	setfather(r, arg3);
+	return r;
 }
+exp
+f_mult(error_treatment ov_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 (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1))) {
+		failer(CHSH_MULT);
+	}
+#endif
-exp f_n_copies
+#if !has64bits
+	if (name(sh(arg1)) >= s64hd &&
+	    (name(arg1) != val_tag || name(arg2) != val_tag ||
-    PROTO_N ( (n, arg1) )
+	     ov_err.err_code > 2)) {
+		return TDFcallop2(ov_err, arg1, arg2, mult_tag);
+	}
+#endif
+	return me_b1(ov_err, arg1, arg2, mult_tag);
+}
+exp
-    PROTO_T ( nat n X exp arg1 )
+f_n_copies(nat n, exp arg1)
 {
-  exp r;
+	exp r;
-  if (name(sh(arg1)) == bothd)
+	if (name(sh(arg1)) == bothd) {
-    return arg1;
+		return arg1;
+	}
 #if !has64bits
-  if (!nat_issmall(n))
+	if (!nat_issmall(n)) {
-    failer(TOO_BIG_A_VECTOR);
+		failer(TOO_BIG_A_VECTOR);
+	}
 #endif
-  r = getexp(f_nof(n, sh(arg1)), nilexp, 0, arg1, nilexp,
+	r = getexp(f_nof(n, sh(arg1)), nilexp, 0, arg1, nilexp, 0, natint(n),
-, natint(n), ncopies_tag);
+		   ncopies_tag);
-  if (name(sh(arg1))==bitfhd) {
+	if (name(sh(arg1)) == bitfhd) {
-	/* make ncopies bitfields into (ncopies) make-compound */
+		/* make ncopies bitfields into (ncopies) make-compound */
-	int sf = shape_size(sh(arg1));
+		int sf = shape_size(sh(arg1));
-	int snof = shape_size(sh(r));
+		int snof = shape_size(sh(r));
-	int scs = (((sf-1)&sf)==0)?sf:snof;
+		int scs = (((sf - 1) &sf) ==0) ? sf : snof;
-	shape cs = containedshape( scs, 1);
+		shape cs = containedshape(scs, 1);
-	exp_list a;
+		exp_list a;
-	shape cpds = f_compound(hold_check(f_offset_pad(f_alignment(cs),
+		shape cpds = f_compound(hold_check(f_offset_pad(f_alignment(cs),
-					f_shape_offset(sh(r)))));
+		    f_shape_offset(sh(r)))));
-	exp soff = getexp(f_offset(f_alignment(cpds), f_alignment(sh(arg1))),
+		exp soff = getexp(f_offset(f_alignment(cpds),
+					   f_alignment(sh(arg1))), nilexp, 0,
-			  nilexp, 0, nilexp, nilexp, 0, 0, val_tag);
+				  nilexp, nilexp, 0, 0, val_tag);
-	exp cexp;
+		exp cexp;
-	a.start = copyexp(soff);
+		a.start = copyexp(soff);
-	a.end = a.start;
+		a.end = a.start;
-	a.number = 2;
+		a.number = 2;
-	bro(a.end) = copyexp(arg1);
-        a.end = bro(a.end);
-	for(no(soff)=sf; no(soff) <= shape_size(cs)-sf; no(soff)+=sf ) {
-		bro(a.end) = copyexp(soff); clearlast(a.end);
-		a.end = bro(a.end);
 		bro(a.end) = copyexp(arg1);
 		a.end = bro(a.end);
+		for (no(soff) = sf; no(soff) <= shape_size(cs) -sf;
+		     no(soff) +=sf) {
+			bro(a.end) = copyexp(soff);
+			clearlast(a.end);
+			a.end = bro(a.end);
+			bro(a.end) = copyexp(arg1);
+			a.end = bro(a.end);
-		a.number +=2;
+			a.number += 2;
-	}
+		}
-	setlast(a.end);
+		setlast(a.end);
-	bro(a.end) = nilexp;
+		bro(a.end) = nilexp;
-	cexp = f_make_compound(hold_check(f_shape_offset(cs)), a);
+		cexp = f_make_compound(hold_check(f_shape_offset(cs)), a);
-	if (shape_size(cs) >=shape_size(cpds)) {
+		if (shape_size(cs) >= shape_size(cpds)) {
-		return cexp;
+			return cexp;
-	}
-	else {
+		} else {
-		natint(n) = shape_size(cpds)/shape_size(cs);
+			natint(n) = shape_size(cpds) / shape_size(cs);
-		return f_n_copies(n, cexp);
+			return f_n_copies(n, cexp);
-	}
+		}
-  }
+	}
-  setfather(r, arg1);
+	setfather(r, arg1);
-  return r;
+	return r;
+}
+exp
+f_negate(error_treatment ov_err, exp arg1)
+{
+	if (name(sh(arg1)) == bothd) {
+		return arg1;
+	}
+#if check_shape
+	if (!is_integer(sh(arg1))) {
+		failer(CHSH_NEGATE);
+	}
+#endif
+	if (!is_signed(sh(arg1)) && ov_err.err_code > 2) {
+		return f_minus(ov_err, me_shint(sh(arg1), 0), arg1);
+	}
+#if !has64bits
+	if (name(sh(arg1)) >= s64hd &&
+	    (name(arg1) != val_tag|| ov_err.err_code > 2)) {
+		return TDFcallop1(ov_err, arg1, neg_tag);
+	}
+#endif
+	return me_u1(ov_err, arg1, neg_tag);
+}
-exp f_negate
+exp
-    PROTO_N ( (ov_err, arg1) )
+f_not(exp arg1)
-    PROTO_T ( error_treatment ov_err X exp arg1 )
+{
-  if (name(sh(arg1)) == bothd)
+	if (name(sh(arg1)) == bothd) {
-    return arg1;
+		return arg1;
+	}
 #if check_shape
-  if (!is_integer(sh(arg1)))
+	if (!is_integer(sh(arg1))) {
-    failer(CHSH_NEGATE);
+		failer(CHSH_NOT);
+	}
 #endif
-  if (!is_signed(sh(arg1)) && ov_err.err_code >2) {
-	return f_minus(ov_err, me_shint(sh(arg1),0), arg1);
-  }
 #if !has64bits
 	if (name(sh(arg1)) >= s64hd &&
-		(name(arg1)!=val_tag|| ov_err.err_code > 2 )) {
+	    name(arg1) != val_tag) {
-		return TDFcallop1(ov_err,arg1,neg_tag);
+		return TDFcallop4(arg1, not_tag);
 	}
-#endif
-  return me_u1(ov_err, arg1, neg_tag);
-}
-exp f_not
-    PROTO_N ( (arg1) )
-    PROTO_T ( exp arg1 )
-{
-  if (name(sh(arg1)) == bothd)
-    return arg1;
-#if check_shape
-  if (!is_integer(sh(arg1)))
-    failer(CHSH_NOT);
 #endif
-#if !has64bits
-	if (name(sh(arg1)) >= s64hd &&
-		name(arg1)!=val_tag ){
-		return TDFcallop4(arg1,not_tag);
+	return me_u2(arg1, not_tag);
-	}
+}
-#endif
-  return me_u2(arg1, not_tag);
-}
-exp f_obtain_tag
+exp
-    PROTO_N ( (t) )
-    PROTO_T ( tag t )
+f_obtain_tag(tag t)
 {
-   shape s;
+	shape s;
-   exp r;
+	exp r;
-   exp tg = get_tag(t);
+	exp tg = get_tag(t);
-   if (tg == nilexp)
+	if (tg == nilexp) {
-     failer(UNDEF_TAG);
+		failer(UNDEF_TAG);
+	}
-   if (isglob(tg))
+	if (isglob(tg)) {
-     {
-        s = sh(t -> dec_u.dec_val.dec_exp);
+		s = sh(t->dec_u.dec_val.dec_exp);
 #ifdef NEWDIAGS
-	if (!within_diags)
+		if (!within_diags) {
-          proc_externs = 1;
+			proc_externs = 1;
+		}
 #else
-        proc_externs = 1;
+		proc_externs = 1;
 #endif
-     }
-   else
+	} else {
-     s = sh(son(tg));
+		s = sh(son(tg));
+	}
-   if (isvar(tg)) {
+	if (isvar(tg)) {
-     if (isparam(tg)) {
+		if (isparam(tg)) {
-	s = f_pointer(f_parameter_alignment(s));
+			s = f_pointer(f_parameter_alignment(s));
-     }
-     else {
+		} else {
-      	s = f_pointer(f_alignment(s));
+			s = f_pointer(f_alignment(s));
-     }
+		}
-   }
+	}
-   r = getexp (s, nilexp, 0, tg, pt (tg), 0, 0, name_tag);
+	r = getexp(s, nilexp, 0, tg, pt(tg), 0, 0, name_tag);
-   pt(tg) = r;
+	pt(tg) = r;
-   no(tg) = no(tg)+1;
+	no(tg) = no(tg) +1;
-   return(r);
+	return (r);
-}
-exp f_offset_add
-    PROTO_N ( (arg1, arg2) )
-    PROTO_T ( exp arg1 X exp arg2 )
-{
-  shape sres;
-  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 (!doing_aldefs &&
-	((name(sh(arg1)) != offsethd || name(sh(arg2)) != offsethd ||
-       (al1(sh(arg2)) > al2(sh(arg1))
-#if issparc
-		&& al1_of(sh(arg2)) != REAL_ALIGN
-#endif
-	) )))
-    failer(CHSH_OFFSETADD);
-#endif
-  sres = f_offset(al1_of(sh(arg1)), al2_of(sh(arg2)));
-#if 0
-	  if ((al1_of(sh(arg1))->al.al_val.al_frame & 4) != 0 &&
-		al2_of(sh(arg2))->al.sh_hd != 0) {
-		exp ne;
-		if (al2_of(sh(arg2))->al.sh_hd > nofhd) {
-		        shape ps = f_pointer(f_alignment(sh(arg1)));
-			ne = hold_check(
-                                f_offset_pad(f_alignment(ps), f_shape_offset(ps))
-			     );
-		}
-		else {
-			ne = arg2;
-		}
-		arg2 = hold_check(me_u2(ne, offset_negate_tag));
-	  }
-#endif
-  return me_b3(sres,arg1, arg2, offset_add_tag);
+}
-exp f_offset_div
-    PROTO_N ( (v, arg1, arg2) )
-    PROTO_T ( variety v 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 (name(sh(arg1)) != offsethd || name(sh(arg2)) != offsethd)
-    failer(CHSH_OFFSETDIV);
-#endif
-  return me_b3(f_integer(v), arg1, arg2, offset_div_tag);
-}
-exp f_offset_div_by_int
-    PROTO_N ( (arg1, arg2) )
-    PROTO_T ( 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 (!doing_aldefs &&
-	(name(sh(arg1)) != offsethd || !is_integer(sh(arg2)) ||
-       (al1(sh(arg1)) != al2(sh(arg1)) && al2(sh(arg1))!=1)) )
-    failer(CHSH_OFFSETDIVINT);
-#endif
-  return me_b3(sh(arg1), arg1, arg2, offset_div_by_int_tag);
-}
-exp f_offset_max
-    PROTO_N ( (arg1, arg2) )
-    PROTO_T ( exp arg1 X exp arg2 )
-{
-  alignment a1 = al1_of(sh(arg1));
-  alignment a2 = al1_of(sh(arg2));
-  alignment a3 = al2_of(sh(arg1));
-  shape sha;
-  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 (!doing_aldefs &&
-	(name(sh(arg1)) != offsethd || name(sh(arg2)) != offsethd))
-    failer(CHSH_OFFSETMAX);
-#endif
-  if (a1->al.al_n != 1 || a2->al.al_n != 1) {
-    alignment ares = (alignment)calloc(1, sizeof(aldef));
-    if (!doing_aldefs)
-       failer(CHSH_OFFSETMAX);
-    ares->al.al_n = 2;
-    ares->al.al_val.al_join.a = a1;
-    ares->al.al_val.al_join.b = a2;
-    ares->next_aldef = top_aldef;
-    top_aldef = ares;
-    sha = f_offset(ares, a3);
-  }
+exp
-  else
-   sha = f_offset(long_to_al(max(a1->al.al_val.al,
-				 a2->al.al_val.al)),
-			 a3);
-  return me_b3(sha, arg1, arg2, offset_max_tag);
-}
-exp f_offset_mult
-    PROTO_N ( (arg1, arg2) )
-    PROTO_T ( exp arg1 X exp arg2 )
+f_offset_add(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 (!doing_aldefs &&
-	(name(sh(arg1)) != offsethd || !is_integer(sh(arg2))))
-    failer(CHSH_OFFSETMULT);
-#endif
-  if (shape_size(sh(arg2)) != PTR_SZ) {
-    if (PTR_SZ == 32)
-      arg2 = hold_check(f_change_variety(f_impossible, slongsh, arg2));
-    else
-      arg2 = hold_check(f_change_variety(f_impossible, s64sh, arg2));
-  };
-  return me_b3(sh(arg1), arg2, arg1, offset_mult_tag);
-    /* the order of arguments is being interchanged */
-}
-exp f_offset_negate
-    PROTO_N ( (arg1) )
-    PROTO_T ( exp arg1 )
+{
+	shape sres;
-  if (name(sh(arg1)) == bothd)
+	if (name(sh(arg1)) == bothd) {
+		kill_exp(arg2, arg2);
-    return arg1;
+		return arg1;
+	}
+	if (name(sh(arg2)) == bothd) {
+		kill_exp(arg1, arg1);
+		return arg2;
+	}
 #if check_shape
-  if (!doing_aldefs &&
+	if (!doing_aldefs &&
-	(name(sh(arg1)) != offsethd ||
+	    ((name(sh(arg1)) != offsethd || name(sh(arg2)) != offsethd ||
-       (al1(sh(arg1)) != al2(sh(arg1)) && al2(sh(arg1)) != 1
+	      (al1(sh(arg2)) > al2(sh(arg1))
 #if issparc
-		&& al1_of(sh(arg1)) != REAL_ALIGN
+	       && al1_of(sh(arg2)) != REAL_ALIGN
+#endif
+	       )))) {
+		failer(CHSH_OFFSETADD);
+	}
 #endif
 #endif
-  return div_rem(div0_err, ov_err, arg1, arg2, rem1_aux);
+	return me_b1(ov_err, arg1, arg2, mod_tag);
+}
-exp rem0_aux
+exp
-    PROTO_N ( (ov_err, arg1, arg2) )
-    PROTO_T ( error_treatment ov_err X exp arg1 X exp arg2 )
+f_rem1(error_treatment div0_err, error_treatment ov_err, exp arg1, exp arg2)
 {
-#if !has64bits
-	if (name(sh(arg1)) >= s64hd &&
+	if (name(sh(arg1)) == bothd) {
-		(name(arg1)!=val_tag || name(arg2) != val_tag|| ov_err.err_code > 2)) {
+		kill_exp(arg2, arg2);
-		return TDFcallop2(ov_err,arg1,arg2,rem0_tag);
+		return arg1;
 	}
-#endif
+	if (name(sh(arg2)) == bothd) {
-#if div0_implemented
+		kill_exp(arg1, arg1);
-  return me_b1(ov_err, arg1, arg2, rem0_tag);
+		return arg2;
-#else
+	}
+#if check_shape
-  if (name(arg2) == val_tag && !isbigval(arg2)) {
+	if (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1))) {
-    int n = no(arg2);
+		failer(CHSH_REM1);
-    if ((n & (n-1)) == 0)
-      return me_b1(ov_err, arg1, arg2, mod_tag);
-  };
+	}
-  return me_b1(ov_err, arg1, arg2, rem2_tag);
 #endif
+	return div_rem(div0_err, ov_err, arg1, arg2, rem1_aux);
+}
-exp f_rem0
-    PROTO_N ( (div0_err, ov_err, arg1, arg2) )
-    PROTO_T ( error_treatment div0_err X error_treatment ov_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 (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1)))
-    failer(CHSH_REM0);
-#endif
-  return div_rem(div0_err, ov_err, arg1, arg2, rem0_aux);
-}
+exp
-exp rem2_aux
-    PROTO_N ( (ov_err, arg1, arg2) )
-    PROTO_T ( error_treatment ov_err X exp arg1 X exp arg2 )
+rem0_aux(error_treatment ov_err, exp arg1, exp arg2)
+{
 #if !has64bits
 	if (name(sh(arg1)) >= s64hd &&
-		(name(arg1)!=val_tag || name(arg2) != val_tag|| ov_err.err_code > 2)) {
+	    (name(arg1) != val_tag || name(arg2) != val_tag ||
+	     ov_err.err_code > 2)) {
-		return TDFcallop2(ov_err,arg1,arg2,rem2_tag);
+		return TDFcallop2(ov_err, arg1, arg2, rem0_tag);
+	}
 #endif
 #endif
+	return div_rem(div0_err, ov_err, arg1, arg2, rem2_aux);
+}
+static int silly_count = 0; /* for pathological numbers of repeats*/
+exp
+f_repeat(label repeat_label_intro, exp start, exp body)
+{
+	exp r = getexp(sh(body), nilexp, 0, start, crt_repeat, 0, 0, rep_tag);
+	exp labst = get_lab(repeat_label_intro);
+	bro(start) = labst;
+	clearlast(start);
+	setbro(son(labst), body);
+	clearlast(son(labst));
+	setbro(body, labst);
+	setlast(body);
+	setsh(labst, sh(body));
+	son(crt_repeat) = r;
+	crt_repeat = bro(crt_repeat);
+	setfather(r, labst);
+	if (silly_count == 0) {
+		default_freq = (float)(default_freq / 20.0);
+	} else {
+		silly_count--;
+	}
+	return r;
+}
+void
+start_repeat(label repeat_label_intro)
+{
+	exp labst;
+	exp def;
+	def = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, clear_tag);
+	/* enter this repeat on crt_repeat and repeat_list - see
+	   documentation */
+	if (crt_repeat != nilexp) {
+		++no(crt_repeat);
+	}
+	repeat_list = getexp(f_top, crt_repeat, 0, nilexp, repeat_list, 1, 0,
+);
+	crt_repeat = repeat_list;
+	labst = getexp(f_bottom, nilexp, 0, def, nilexp, 0, 0, labst_tag);
+	if (default_freq < (float)10e10) {
+		default_freq = (float)(20.0 * default_freq);
+	} else {
+		silly_count++;
+	}
+	fno(labst) = default_freq;
+	++proc_label_count;
+	set_lab(repeat_label_intro, labst);
+	return;
+}
+exp
+f_return(exp arg1)
+{
+	if (name(sh(arg1)) == bothd) {
+		return arg1;
+	}
+	if (!reg_result(sh(arg1))) {
+		proc_struct_res = 1;
+	}
+	/* transformation if we are giving procedures which deliver a struct
+	   result an extra pointer parameter */
+	if (redo_structfns && !reg_result(sh(arg1))) {
+		exp ret, obt;
+		exp assname, ass;
+		shape ptr_res_shape;
+		exp_list list;
+		if (proc_struct_result == nilexp) {
+			exp init = getexp(f_pointer(f_alignment(sh(arg1))),
+					  nilexp, 0, nilexp, nilexp, 0, 0,
+					  clear_tag);
+			exp iddec = getexp(sh(arg1), nilexp, 0, init, nilexp,
+, 0, ident_tag);
+			setparam(iddec);
+			proc_struct_result = iddec;
+		}
+		ptr_res_shape = f_pointer(f_alignment(sh(arg1)));
+		obt = getexp(ptr_res_shape, nilexp, 0, proc_struct_result,
+			     pt(proc_struct_result), 0, 0, name_tag);
+		++no(proc_struct_result);
+		pt(proc_struct_result) = obt;
+		ret = me_u3(f_bottom, obt, res_tag);
+		assname = getexp(ptr_res_shape, nilexp, 0, proc_struct_result,
+				 pt(proc_struct_result), 0, 0, name_tag);
+		++no(proc_struct_result);
+		pt(proc_struct_result) = assname;
+		ass = hold_check(f_assign(assname, arg1));
+		list.number = 1;
+		list.start = ass;
+		list.end = ass;
+		return f_sequence(list, ret);
+	}
-  return me_b2(arg1, arg2, rotr_tag);
+	return me_u3(f_bottom, arg1, res_tag);
+}
-exp f_sequence
-    PROTO_N ( (statements, result) )
-    PROTO_T ( exp_list statements X exp result )
-{
-  exp r;
-  exp h = getexp(f_bottom, result, 0, statements.start,
-                  nilexp, 0, statements.number, 0);
-  exp l = statements.end;
-  clear_exp_list(statements);
-    /* re-organise so that sequence lists do not get too long.
-       limit to MAX_ST_LENGTH */
-  if (statements.number == 0)
-    return result;
-  if (statements.number <= MAX_ST_LENGTH) {
-    setlast(l);
-    setbro(l, h);
-    r = getexp(sh(result), nilexp, 0, h, nilexp, 0, 0, seq_tag);
-    setfather (r, result);
-    return r;
-  }
+exp
-  else {
-    int num_bits = statements.number / MAX_ST_LENGTH;
-    int rest = statements.number - (num_bits*MAX_ST_LENGTH);
-    exp_list work;
-    exp_list res;
-    exp t = statements.start;
-    int i, j;
-    res = new_exp_list(num_bits+1);
-    if (rest == 0)
-      {
-        --num_bits;
-        rest = MAX_ST_LENGTH;
-      };
-    for (i = 0; i < num_bits; ++i)
-      {
-        work.start = t;
-        work.number = MAX_ST_LENGTH;
-        for (j = 0; j < (MAX_ST_LENGTH-1); ++j)
-          t = bro(t);
-        work.end = t;
-        t = bro(t);
-        res = add_exp_list(res,
-                           hold_check(f_sequence(work, f_make_top())),
-			   i);
-      };
-    work.start = t;
-    work.end = l;
-    work.number = rest;
-    res = add_exp_list(res,
-		       hold_check(f_sequence(work, f_make_top())),
-		       num_bits);
-    return f_sequence(res, result);
+f_rotate_left(exp arg1, exp arg2)
-  };
-}
-exp f_shape_offset
-    PROTO_N ( (s) )
-    PROTO_T ( shape s )
+{
-  return getexp(f_offset(f_alignment(s), long_to_al(1)),
+	if (name(sh(arg1)) == bothd) {
-		  nilexp, 0,
+		kill_exp(arg2, arg2);
-                  nilexp, nilexp,
+		return arg1;
-, shape_size(s), val_tag);
-}
+	}
-exp f_shift_left
-    PROTO_N ( (ov_err, arg1, arg2) )
-    PROTO_T ( error_treatment ov_err X exp arg1 X exp arg2 )
-{
-  if (name(sh(arg1)) == bothd)
+	if (name(sh(arg2)) == bothd) {
-    { kill_exp(arg2,arg2); return arg1; }
+		kill_exp(arg1, arg1);
-  if (name(sh(arg2)) == bothd)
-    { kill_exp(arg1,arg1); return arg2; }
+		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_SHL);
+		failer(CHSH_ROTL);
-#endif
-#if !has64bits
-	if (name(sh(arg1)) >= s64hd &&
-		(name(arg1)!=val_tag || name(arg2) != val_tag|| ov_err.err_code > 2)) {
-	    arg2 = hold_check(f_change_variety(ov_err, ulongsh, arg2));
-	    return TDFcallop2(ov_err,arg1,arg2,shl_tag);
+	}
 #endif
+	}
 #endif
+#if !has64bits
+	if (name(sh(arg1)) >= s64hd &&
+	    (name(arg1) != val_tag || name(arg2) != val_tag)) {
+		error_treatment ov_err;
+		ov_err = f_wrap;
+		arg2 = hold_check(f_change_variety(ov_err, ulongsh, arg2));
+		return TDFcallop2(ov_err, arg1, arg2, shr_tag);
+	}
+#endif
-  return me_b2(arg1, arg2, shr_tag);
+	return me_b2(arg1, arg2, shr_tag);
+}
+exp
+f_subtract_ptrs(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;
+	}
+	return me_b3(f_offset(al1_of(sh(arg2)), al1_of(sh(arg1))), arg1, arg2,
+		     minptr_tag);
 }
-exp f_subtract_ptrs
+exp
-    PROTO_N ( (arg1, arg2) )
-    PROTO_T ( exp arg1 X exp arg2 )
+f_variable(access_option acc, tag name_intro, exp init, exp body)
+{
-  if (name(sh(arg1)) == bothd)
+	exp i = get_tag(name_intro);
-    { kill_exp(arg2,arg2); return arg1; }
+	exp d = son(i);
+	UNUSED(acc);
+	UNUSED(init);
-  if (name(sh(arg2)) == bothd)
+	setsh(i, sh(body));
+	setbro(d, body);
+	clearlast(d);
-    { kill_exp(arg1,arg1); return arg2; }
+	setfather(i, body);
+#ifdef NEWDIAGS
-  return me_b3(f_offset(al1_of(sh(arg2)),
+	if (doing_mark_scope) {
-                        al1_of(sh(arg1))),
+		/* must be reading old diags */
-                arg1, arg2, minptr_tag);
+		correct_mark_scope(i);
+	}
+#endif
+	return i;
+}
-exp f_variable
+void
-    PROTO_N ( (acc, name_intro, init, body) )
-    PROTO_T ( access_option acc X tag name_intro X exp init X exp body )
+start_variable(access_option acc, tag name_intro, exp init)
+{
-  exp i = get_tag(name_intro);
+	exp i = get_tag(name_intro);
-  exp d = son(i);
+	if (i == nilexp || son(i) != i) {
-  UNUSED(acc); UNUSED(init);
+		i = getexp(f_bottom, nilexp, 0, init, nilexp, 0, 0, ident_tag);
-  setsh(i, sh(body));
+	} else {
+		/* could have been already used in env_offset */
-  setbro(d, body);
+		son(i) = init;
+	}
-  clearlast(d);
+	setvar(i);
+	if (acc & (f_visible | f_long_jump_access)) {
-  setfather (i, body);
+		setvis(i);
-#ifdef NEWDIAGS
+		setenvoff(i);
-  if (doing_mark_scope)		/* must be reading old diags */
+	} else if ((acc & f_no_other_read) && (acc & f_no_other_write)) {
-    correct_mark_scope (i);
+		setcaonly(i);
-#endif
+	}
+	set_tag(name_intro, i);
-  return i;
+	return;
 }
-void start_variable
+exp
-    PROTO_N ( (acc, name_intro, init) )
+f_xor(exp arg1, exp arg2)
-    PROTO_T ( access_option acc X tag name_intro X exp init )
+{
-  exp i = get_tag(name_intro);
-  if (i == nilexp || son(i) != i) {
+	if (name(sh(arg1)) == bothd) {
-	i = getexp(f_bottom, nilexp, 0, init, nilexp, 0,
-, ident_tag);
+		kill_exp(arg2, arg2);
-  }
-  else {  /* could have been already used in env_offset */
-	son(i) = init;
+		return arg1;
-  }
+	}
-  setvar(i);
-  if (acc & (f_visible | f_long_jump_access))
+	if (name(sh(arg2)) == bothd) {
-   {
-    setvis(i);
-    setenvoff(i);
-   }
-  else
-  if ((acc & f_no_other_read) && (acc & f_no_other_write))
-    setcaonly(i);
-  set_tag(name_intro, i);
+		kill_exp(arg1, arg1);
-  return;
+		return arg2;
-}
+	}
-exp f_xor
-    PROTO_N ( (arg1, arg2) )
-    PROTO_T ( 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 (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1)))
+	if (!eq_shape(sh(arg1), sh(arg2)) || !is_integer(sh(arg1))) {
-    failer(CHSH_XOR);
+		failer(CHSH_XOR);
+	}
 #endif
 #if !has64bits
 	if (name(sh(arg1)) >= s64hd &&
-		(name(arg1)!=val_tag || name(arg2) != val_tag)){
+	    (name(arg1) != val_tag || name(arg2) != val_tag)) {
-		return TDFcallop3(arg1,arg2,xor_tag);
+		return TDFcallop3(arg1, arg2, xor_tag);
+	}
 #endif
-  return me_b2( arg1, arg2, xor_tag);
+	return me_b2(arg1, arg2, xor_tag);
 }
-void init_exp
+void
-    PROTO_Z ()
+init_exp(void)
 {
-  freelist = nilexp;
+	freelist = nilexp;
-  exps_left = 0;
+	exps_left = 0;
-  crt_labno = 0;
+	crt_labno = 0;
-  global_case = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0, 0, 0);
+	global_case = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0, 0, 0);
-  in_initial_value = 0;
+	in_initial_value = 0;
-  	initial_value_pp.proc_struct_result = nilexp;
+	initial_value_pp.proc_struct_result = nilexp;
-  	initial_value_pp.has_alloca = 0;
+	initial_value_pp.has_alloca = 0;
-  	initial_value_pp.proc_is_recursive = 0;
+	initial_value_pp.proc_is_recursive = 0;
-  	initial_value_pp.uses_crt_env = 0;
+	initial_value_pp.uses_crt_env = 0;
-  	initial_value_pp.has_setjmp = 0;
+	initial_value_pp.has_setjmp = 0;
-  	initial_value_pp.uses_loc_address = 0;
+	initial_value_pp.uses_loc_address = 0;
-  	initial_value_pp.proc_label_count = 0;
+	initial_value_pp.proc_label_count = 0;
-  	initial_value_pp.proc_struct_res = 0;
+	initial_value_pp.proc_struct_res = 0;
-  	initial_value_pp.default_freq = default_freq;
+	initial_value_pp.default_freq = default_freq;
-  	initial_value_pp.proc_externs = 0;
+	initial_value_pp.proc_externs = 0;
-  	initial_value_pp.in_proc_def = 0;
+	initial_value_pp.in_proc_def = 0;
-  	initial_value_pp.pushed = (proc_props*)0;
+	initial_value_pp.pushed = (proc_props*)0;
-  	initial_value_pp.rep_make_proc = 0;
+	initial_value_pp.rep_make_proc = 0;
-  return;
+	return;
 }
 exp f_dummy_exp;
-exp f_return_to_label
+exp
-    PROTO_N ( (e) )
-    PROTO_T ( exp e )
+f_return_to_label(exp e)
 {
 	has_lv = 1;
 	return me_u3(f_bottom, e, return_to_label_tag);
+}
+nat
-nat f_computed_nat
+f_computed_nat(exp arg)
-    PROTO_N ( (arg) )
-    PROTO_T ( exp arg )
 {
-  nat res;
+	nat res;
-  if (name(arg) == val_tag)
+	if (name(arg) == val_tag) {
-   {
-     if (extra_checks && constovf(arg))
+		if (extra_checks && constovf(arg)) {
-       failer(ILLNAT);
+			failer(ILLNAT);
+		}
-     if (!isbigval(arg))  {
+		if (!isbigval(arg)) {
-       nat_issmall(res) = 1;
+			nat_issmall(res) = 1;
-       natint(res) = no(arg);
+			natint(res) = no(arg);
-       return res;
+			return res;
-     }
-     else  {
+		} else {
-       nat_issmall(res) = 0;
+			nat_issmall(res) = 0;
-       natbig(res) = no(arg);
+			natbig(res) = no(arg);
-       return res;
+			return res;
-     };
+		}
-   };
+	}
-  if (name(arg) == name_tag && !isvar(son(arg))) {
+	if (name(arg) == name_tag && !isvar(son(arg))) {
-    res = f_computed_nat(son(son(arg)));
+		res = f_computed_nat(son(son(arg)));
-    kill_exp(arg, arg);
+		kill_exp(arg, arg);
-    return res;
+		return res;
-  };
+	}
-  failer(ILLCOMPNAT);
+	failer(ILLCOMPNAT);
-  nat_issmall(res) = 1;
+	nat_issmall(res) = 1;
-  natint(res) = 1;
+	natint(res) = 1;
-  return res;
+	return res;
 }
-nat f_make_nat
+nat
-    PROTO_N ( (n) )
-    PROTO_T ( tdfint n )
+f_make_nat(tdfint n)
 {
-  return n;
+	return n;
 }
-void init_nat
+void
-    PROTO_Z ()
+init_nat(void)
 {
-  return;
+	return;
 }
 nat f_dummy_nat;
-void init_ntest
+void
-    PROTO_Z ()
+init_ntest(void)
+{
-  return;
+	return;
+}
-void init_otagexp
+void
-    PROTO_Z ()
+init_otagexp(void)
+{
 	return;
+}
+void
-void init_procprops
+init_procprops(void)
+{
+	return;
+}
-    PROTO_Z ()
+ntest f_dummy_ntest;
+void
+init_rounding_mode(void)
+{
 	return;
+}
-ntest f_dummy_ntest;
-void init_rounding_mode
-    PROTO_Z ()
-{
-  return;
-}
 rounding_mode f_dummy_rounding_mode;
-shape f_bitfield
+shape
-    PROTO_N ( (bf_var) )
-    PROTO_T ( bitfield_variety bf_var )
+f_bitfield(bitfield_variety bf_var)
-{
-  return getshape(bf_var.has_sign, const_al1, const_al1,
-                   BF_ALIGN, bf_var.bits, bitfhd);
-}
-shape f_compound
-    PROTO_N ( (off) )
-    PROTO_T ( exp off )
-{
-  int sz;
-  if (name(off)==val_tag)
-    sz = no(off);
-  else
-    {failer(ILLCPDOFFSET);
-     sz = 0;
-    };
-  return getshape(0, const_al1, const_al1,
-		   al1_of(sh(off)),
-		   sz, cpdhd);
-}
-shape f_floating
-    PROTO_N ( (fv) )
-    PROTO_T ( floating_variety fv )
-{
-  switch (fv)
-   {
-     case shrealfv:
-          return shrealsh;
-     case realfv:
-	  return realsh;
-     case doublefv:
-          return doublesh;
-     case shcomplexfv:
-	  return shcomplexsh;
-     case complexfv:
-	  return complexsh;
-     case complexdoublefv:
-	  return complexdoublesh;
-   };
-   return realsh;
-}
-shape f_integer
-    PROTO_N ( (var) )
-    PROTO_T ( variety var )
-{
-  return var;
-}
-shape f_nof
-    PROTO_N ( (n, s) )
-    PROTO_T ( nat n X shape s )
-{
-  if (doing_aldefs)
-    return s;
-  else  {
-    int al = shape_align(s);
-    int sz = rounder (shape_size(s), al);
-    int nm = (int)name(s);
-    int nofsz = natint(n)*sz;
-    shape res;
-    if (name(s) == nofhd)
-      nm = ptno(s);
-#if !has64bits
-    if (!nat_issmall(n))
-      failer(TOO_BIG_A_VECTOR);
-#endif
-    if (name(s) == tophd) {
-	/* pathological - make it nof(0, char) */
-	res = getshape(0, const_al1, const_al1,align_of(ucharsh), 0, nofhd);
-    }
-    else
-    if (al == 1) {
-        if ( (sz &(sz-1)) != 0 && nofsz > BF_STORE_UNIT) {
-		IGNORE fprintf(stderr, "Warning: Bitfields of nof cannot all be variety enclosed \n");
-	}
-	if ((sz &(sz-1)) == 0 || nofsz > BF_STORE_UNIT) {
-		shape news = containedshape(sz,1);
-		int nsz = shape_align(news);
-		int newn = rounder(nofsz, nsz);
-		res = getshape(0, const_al1, const_al1, align_of(news),
-				newn, nofhd);
-	}
-	else {
-		shape news = containedshape(nofsz,1);
-		res = getshape(0, const_al1, const_al1, align_of(news),
-				shape_size(news), cpdhd);
-	}
-    }
-    else {
-    	res = getshape(0, const_al1, const_al1, align_of(s), nofsz, nofhd);
-    }
-    ptno(res) = nm;	/* set the pt field of the shape to the
-			   shapemacs.h hd identifier of the shape */
-    return res;
-  };
-}
-shape f_offset
-    PROTO_N ( (arg1, arg2) )
-    PROTO_T ( alignment arg1 X alignment arg2 )
-{
-    /* use values pre-computed by init since we never alter shapes */
-  if (arg1->al.al_n != 1 || arg2->al.al_n != 1 ||
-       arg1->al.sh_hd != 0 || arg2->al.sh_hd != 0
-     || arg1->al.al_val.al_frame !=0 || arg2->al.al_val.al_frame != 0)
-    return getshape(0, arg1, arg2, OFFSET_ALIGN, OFFSET_SZ, offsethd);
- /* use values pre-computed by init since we never alter shapes */
-  switch (arg1->al.al_val.al)
-   {
-     case 512:
-       switch (arg2->al.al_val.al)
-        {
-          case 512: return f_off512_512;
-          case 64: return f_off512_64;
-          case 32: return f_off512_32;
-          case 16: return f_off512_16;
-          case 8: return f_off512_8;
-          case 1: return f_off512_1;
-          default: failer(ILLOFF2); return f_off64_8;
-        };
-     case 64:
-       switch (arg2->al.al_val.al)
-        {
-          case 64: return f_off64_64;
-          case 32: return f_off64_32;
-          case 16: return f_off64_16;
-          case 8: return f_off64_8;
-          case 1: return f_off64_1;
-          default: failer(ILLOFF2); return f_off64_8;
-        };
-     case 32:
-       switch (arg2->al.al_val.al)
-        {
-          case 32: return f_off32_32;
-          case 16: return f_off32_16;
-          case 8: return f_off32_8;
-          case 1: return f_off32_1;
-          default: failer(ILLOFF2); return f_off32_8;
-        };
-     case 16:
-       switch (arg2->al.al_val.al)
-        {
-          case 16: return f_off16_16;
-          case 8: return f_off16_8;
-          case 1: return f_off16_1;
-          default: failer(ILLOFF2); return f_off16_8;
-        };
-     case 8:
-       switch (arg2->al.al_val.al)
-        {
-          case 8: return f_off8_8;
-          case 1: return f_off8_1;
-          default: failer(ILLOFF2); return f_off8_8;
-        };
-     case 1:
-       switch (arg2->al.al_val.al)
-        {
-          case 1: return f_off1_1;
-          default: failer(ILLOFF2); return f_off1_1;
-        };
-     default: failer(ILLOFF1); return f_off8_8;
-   };
-}
-static shape frame_ptrs[32];
-static struct SAL{alignment al; shape ptr_sh; struct SAL * rest;} * cache_pashs;
-shape f_pointer
-    PROTO_N ( (arg) )
-    PROTO_T ( alignment arg )
-{
-    /* use values pre-computed by init since we never alter shapes */
-  int af = arg->al.al_val.al_frame;
-  if (arg->al.al_n != 1 && af == 0)
-    return getshape(0, arg, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);
-  if (af != 0) {
-	if (frame_ptrs[af] == (shape)0) {
-		frame_ptrs[af] =
-			getshape(0, arg, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);
-	}
-	return frame_ptrs[af];
-  }
-  if (arg->al.sh_hd !=0) {
-	struct SAL * c = cache_pashs;
-	shape res;
-	while (c != (struct SAL*)0) {
-		if (arg == c->al) return c->ptr_sh;
-		c = c->rest;
-	}
-	res = getshape(0, arg, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);
-	c = (struct SAL*)xmalloc(sizeof(struct SAL));
-	c->al = arg; c->ptr_sh = res; c->rest = cache_pashs;
-	cache_pashs = c;
-	return res;
-  }
-  switch (arg->al.al_val.al)
-   {
-     case 1: return f_ptr1;
-     case 8: return f_ptr8;
-     case 16: return f_ptr16;
-     case 32: return f_ptr32;
-     case 64: return f_ptr64;
-     default: failer(ILLALIGN); return f_ptr8;
-   };
-}
-shape f_proc;
-void init_shape
-    PROTO_Z ()
+{
-   /* pre-compute values for use in f_pointer and f_offset */
+	return getshape(bf_var.has_sign, const_al1, const_al1, BF_ALIGN,
+			bf_var.bits, bitfhd);
+}
+shape
+f_compound(exp off)
+{
-  int i;
+	int sz;
+	if (name(off) ==val_tag) {
+		sz = no(off);
+	} else {
+		failer(ILLCPDOFFSET);
+		sz = 0;
+	}
+	return getshape(0, const_al1, const_al1, al1_of(sh(off)), sz, cpdhd);
+}
+shape
+f_floating(floating_variety fv)
+{
+	switch (fv)
+	{
+	case shrealfv:
+		return shrealsh;
+	case realfv:
+		return realsh;
+	case doublefv:
+		return doublesh;
+	case shcomplexfv:
+		return shcomplexsh;
+	case complexfv:
+		return complexsh;
+	case complexdoublefv:
+		return complexdoublesh;
+	}
+	return realsh;
+}
+shape
+f_integer(variety var)
+{
+	return var;
+}
+shape
+f_nof(nat n, shape s)
+{
+	if (doing_aldefs) {
+		return s;
+	} else {
+		int al = shape_align(s);
-  for(i=0; i<32; i++) frame_ptrs[i] = (shape)0;
+		int sz = rounder(shape_size(s), al);
+		int nm = (int)name(s);
-  cache_pashs = (struct SAL*)0;
+		int nofsz = natint(n)*sz;
+		shape res;
+		if (name(s) == nofhd) {
+			nm = ptno(s);
+		}
+#if !has64bits
+		if (!nat_issmall(n)) {
+			failer(TOO_BIG_A_VECTOR);
+		}
+#endif
+		if (name(s) == tophd) {
+			/* pathological - make it nof(0, char) */
+			res = getshape(0, const_al1, const_al1,
+				       align_of(ucharsh), 0, nofhd);
+		} else if (al == 1) {
+			if ((sz & (sz - 1)) != 0 && nofsz > BF_STORE_UNIT) {
+				IGNORE fprintf(stderr, "Warning: Bitfields of nof cannot all be variety enclosed \n");
+			}
+			if ((sz & (sz - 1)) == 0 || nofsz > BF_STORE_UNIT) {
+				shape news = containedshape(sz, 1);
+				int nsz = shape_align(news);
+				int newn = rounder(nofsz, nsz);
+				res = getshape(0, const_al1, const_al1,
+					       align_of(news), newn, nofhd);
+			} else {
+				shape news = containedshape(nofsz, 1);
+				res = getshape(0, const_al1, const_al1,
+					       align_of(news), shape_size(news),
+					       cpdhd);
+			}
+		} else {
+			res = getshape(0, const_al1, const_al1, align_of(s),
+				       nofsz, nofhd);
+		}
+		ptno(res) = nm;	/* set the pt field of the shape to the
+				   shapemacs.h hd identifier of the shape */
+		return res;
+	}
+}
-  f_bottom = getshape(0, const_al1, const_al1, const_al1, 0, bothd);
-  f_top = getshape(0, const_al1, const_al1, TOP_ALIGN, TOP_SZ, tophd);
-  f_proc = getshape(0, const_al1, const_al1, PROC_ALIGN, PROC_SZ, prokhd);
-  f_ptr1 = getshape(0, const_al1, const_al1, PTR_ALIGN, PTRBIT_SZ, ptrhd);
-  f_ptr8 = getshape(0, const_al8, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);
-  f_local_label_value = f_ptr8;
-  f_ptr16 = getshape(0, const_al16, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);
+shape
+f_offset(alignment arg1, alignment arg2)
+{
+	/* use values pre-computed by init since we never alter shapes */
+	if (arg1->al.al_n != 1 || arg2->al.al_n != 1 || arg1->al.sh_hd != 0 ||
+	    arg2->al.sh_hd != 0 || arg1->al.al_val.al_frame != 0 ||
+	    arg2->al.al_val.al_frame != 0) {
-  f_ptr32 = getshape(0, const_al32, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);
+		return getshape(0, arg1, arg2, OFFSET_ALIGN, OFFSET_SZ,
+				offsethd);
+	}
+	/* use values pre-computed by init since we never alter shapes */
+	switch (arg1->al.al_val.al) {
+	case 512:
+		switch (arg2->al.al_val.al) {
+		case 512:
+			return f_off512_512;
+		case 64:
+			return f_off512_64;
+		case 32:
+			return f_off512_32;
+		case 16:
+			return f_off512_16;
+		case 8:
+			return f_off512_8;
+		case 1:
+			return f_off512_1;
+		default:
+			failer(ILLOFF2);
+			return f_off64_8;
+		}
+	case 64:
+		switch (arg2->al.al_val.al) {
+		case 64:
+			return f_off64_64;
+		case 32:
+			return f_off64_32;
+		case 16:
+			return f_off64_16;
+		case 8:
+			return f_off64_8;
+		case 1:
+			return f_off64_1;
+		default:
+			failer(ILLOFF2);
+			return f_off64_8;
+		}
+	case 32:
+		switch (arg2->al.al_val.al) {
+		case 32:
+			return f_off32_32;
+		case 16:
+			return f_off32_16;
+		case 8:
+			return f_off32_8;
+		case 1:
+			return f_off32_1;
+		default:
+			failer(ILLOFF2);
+			return f_off32_8;
+		}
+	case 16:
+		switch (arg2->al.al_val.al) {
+		case 16:
+			return f_off16_16;
+		case 8:
+			return f_off16_8;
+		case 1:
+			return f_off16_1;
+		default:
+			failer(ILLOFF2);
+			return f_off16_8;
+		}
+	case 8:
+		switch (arg2->al.al_val.al) {
+		case 8:
+			return f_off8_8;
+		case 1:
+			return f_off8_1;
+		default:
+			failer(ILLOFF2);
+			return f_off8_8;
+		}
+	case 1:
+		switch (arg2->al.al_val.al) {
+		case 1:
+			return f_off1_1;
+		default:
+			failer(ILLOFF2);
+			return f_off1_1;
+		}
+	default:
+		failer(ILLOFF1);
+		return f_off8_8;
+	}
+}
-  f_ptr64 = getshape(0, const_al64, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);
+static shape frame_ptrs[32];
-  f_off1_1 = getshape(1, const_al1, const_al1,
+static struct SAL {
+	alignment al;
+	shape ptr_sh;
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
+	struct SAL *rest;
+} *cache_pashs;
+shape
+f_pointer(alignment arg)
+{
+	/* use values pre-computed by init since we never alter shapes */
-  f_off0_0 = getshape(1, const_al1, const_al1,
+	int af = arg->al.al_val.al_frame;
+	if (arg->al.al_n != 1 && af == 0) {
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
+		return getshape(0, arg, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);
+	}
+	if (af != 0) {
+		if (frame_ptrs[af] == (shape)0) {
-  f_off8_8 = getshape(1, const_al8, const_al8,
+			frame_ptrs[af] = getshape(0, arg, const_al1, PTR_ALIGN,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
+						  PTR_SZ, ptrhd);
+		}
+		return frame_ptrs[af];
+	}
+	if (arg->al.sh_hd != 0) {
+		struct SAL *c = cache_pashs;
+		shape res;
-  f_off8_1 = getshape(1, const_al8, const_al1,
+		while (c != (struct SAL*)0) {
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
+			if (arg == c->al) return c->ptr_sh;
+			c = c->rest;
+		}
-  f_off16_16 = getshape(1, const_al16, const_al16,
+		res = getshape(0, arg, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);
+		c = (struct SAL*)xmalloc(sizeof(struct SAL));
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
+		c->al = arg; c->ptr_sh = res; c->rest = cache_pashs;
+		cache_pashs = c;
+		return res;
+	}
-  f_off16_8 = getshape(1, const_al16, const_al8,
+	switch (arg->al.al_val.al)
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
+	{
+	case 1: return f_ptr1;
+	case 8: return f_ptr8;
-  f_off16_1 = getshape(1, const_al16, const_al1,
+	case 16: return f_ptr16;
+	case 32: return f_ptr32;
+	case 64: return f_ptr64;
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
+	default: failer(ILLALIGN); return f_ptr8;
+	};
+}
-  f_off32_32 = getshape(1, const_al32, const_al32,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  f_off32_16 = getshape(1, const_al32, const_al16,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  f_off32_8 = getshape(1, const_al32, const_al8,
+shape f_proc;
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  f_off32_1 = getshape(1, const_al32, const_al1,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  f_off64_64 = getshape(1, const_al64, const_al64,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  f_off64_32 = getshape(1, const_al64, const_al32,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  f_off64_16 = getshape(1, const_al64, const_al16,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  f_off64_8 = getshape(1, const_al64, const_al8,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  f_off64_1 = getshape(1, const_al64, const_al1,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  f_off512_512 = getshape(1, const_al512, const_al512,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  f_off512_64 = getshape(1, const_al512, const_al64,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  f_off512_32 = getshape(1, const_al512, const_al32,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  f_off512_16 = getshape(1, const_al512, const_al16,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  f_off512_8 = getshape(1, const_al512, const_al8,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  f_off512_1 = getshape(1, const_al512, const_al1,
-                        OFFSET_ALIGN, OFFSET_SZ, offsethd);
-  return;
-}
+void
-shape f_dummy_shape;
-signed_nat f_computed_signed_nat
+init_shape(void)
-    PROTO_N ( (arg) )
-    PROTO_T ( exp arg )
+{
-  signed_nat res;
-  if (name(arg) == val_tag)
-   {
-     if (extra_checks && constovf(arg))
-       failer(ILLNAT);
-     if (!isbigval(arg)) {
-       snat_issmall(res) = 1;
-       if (!is_signed(sh(arg)))
-        {
-         snatneg(res) = 0;
-         snatint(res) = no(arg);
-        }
-       else
-        {if (no(arg) < 0)
-          {
-            snatneg(res) = 1;
-            snatint(res) = -no(arg);
-          }
-         else
-          {
-            snatneg(res) = 0;
-            snatint(res) = no(arg);
-          }
-        };
-       return res;
-     }
-     else  {
-       snat_issmall(res) = 0;
-       snatneg(res) = (bool)(flptnos[no(arg)].sign == -1);
+	/* pre-compute values for use in f_pointer and f_offset */
-       flptnos[no(arg)].sign = 1;
-       snatint(res) = no(arg);
-       return res;
-     };
-  };
+	int i;
+	for (i = 0; i < 32; i++) {
+		frame_ptrs[i] = (shape)0;
+	}
+	cache_pashs = (struct SAL *)0;
-  if (name(arg) == name_tag && !isvar(son(arg))) {
+	f_bottom = getshape(0, const_al1, const_al1, const_al1, 0, bothd);
+	f_top = getshape(0, const_al1, const_al1, TOP_ALIGN, TOP_SZ, tophd);
+	f_proc = getshape(0, const_al1, const_al1, PROC_ALIGN, PROC_SZ, prokhd);
+	f_ptr1 = getshape(0, const_al1, const_al1, PTR_ALIGN, PTRBIT_SZ, ptrhd);
+	f_ptr8 = getshape(0, const_al8, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);
-    res = f_computed_signed_nat(son(son(arg)));
+	f_local_label_value = f_ptr8;
+	f_ptr16 = getshape(0, const_al16, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);
+	f_ptr32 = getshape(0, const_al32, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);
+	f_ptr64 = getshape(0, const_al64, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);
+	f_off1_1 = getshape(1, const_al1, const_al1, OFFSET_ALIGN, OFFSET_SZ,
+			    offsethd);
+	f_off0_0 = getshape(1, const_al1, const_al1, OFFSET_ALIGN, OFFSET_SZ,
+			    offsethd);
+	f_off8_8 = getshape(1, const_al8, const_al8, OFFSET_ALIGN, OFFSET_SZ,
+			    offsethd);
+	f_off8_1 = getshape(1, const_al8, const_al1, OFFSET_ALIGN, OFFSET_SZ,
+			    offsethd);
+	f_off16_16 = getshape(1, const_al16, const_al16, OFFSET_ALIGN,
+			      OFFSET_SZ, offsethd);
+	f_off16_8 = getshape(1, const_al16, const_al8, OFFSET_ALIGN, OFFSET_SZ,
+			     offsethd);
+	f_off16_1 = getshape(1, const_al16, const_al1, OFFSET_ALIGN, OFFSET_SZ,
+			     offsethd);
+	f_off32_32 = getshape(1, const_al32, const_al32, OFFSET_ALIGN,
+			      OFFSET_SZ, offsethd);
+	f_off32_16 = getshape(1, const_al32, const_al16, OFFSET_ALIGN,
+			      OFFSET_SZ, offsethd);
+	f_off32_8 = getshape(1, const_al32, const_al8, OFFSET_ALIGN, OFFSET_SZ,
+			     offsethd);
+	f_off32_1 = getshape(1, const_al32, const_al1, OFFSET_ALIGN, OFFSET_SZ,
+			     offsethd);
+	f_off64_64 = getshape(1, const_al64, const_al64, OFFSET_ALIGN,
+			      OFFSET_SZ, offsethd);
+	f_off64_32 = getshape(1, const_al64, const_al32, OFFSET_ALIGN,
+			      OFFSET_SZ, offsethd);
+	f_off64_16 = getshape(1, const_al64, const_al16, OFFSET_ALIGN,
-    kill_exp(arg, arg);
+			      OFFSET_SZ, offsethd);
+	f_off64_8 = getshape(1, const_al64, const_al8, OFFSET_ALIGN, OFFSET_SZ,
+			     offsethd);
+	f_off64_1 = getshape(1, const_al64, const_al1, OFFSET_ALIGN, OFFSET_SZ,
-    return res;
+			     offsethd);
+	f_off512_512 = getshape(1, const_al512, const_al512, OFFSET_ALIGN,
+				OFFSET_SZ, offsethd);
+	f_off512_64 = getshape(1, const_al512, const_al64, OFFSET_ALIGN,
+			       OFFSET_SZ, offsethd);
+	f_off512_32 = getshape(1, const_al512, const_al32, OFFSET_ALIGN,
+			       OFFSET_SZ, offsethd);
+	f_off512_16 = getshape(1, const_al512, const_al16, OFFSET_ALIGN,
+			       OFFSET_SZ, offsethd);
+	f_off512_8 = getshape(1, const_al512, const_al8, OFFSET_ALIGN,
+			      OFFSET_SZ, offsethd);
-  };
+	f_off512_1 = getshape(1, const_al512, const_al1, OFFSET_ALIGN,
+			      OFFSET_SZ, offsethd);
+	return;
+}
+shape f_dummy_shape;
+signed_nat
+f_computed_signed_nat(exp arg)
+{
+	signed_nat res;
+	if (name(arg) == val_tag) {
+		if (extra_checks && constovf(arg)) {
+			failer(ILLNAT);
+		}
+		if (!isbigval(arg)) {
+			snat_issmall(res) = 1;
+			if (!is_signed(sh(arg))) {
+				snatneg(res) = 0;
+				snatint(res) = no(arg);
+			} else {
+				if (no(arg) < 0) {
+					snatneg(res) = 1;
+					snatint(res) = -no(arg);
+				} else {
+					snatneg(res) = 0;
+					snatint(res) = no(arg);
+				}
+			}
+			return res;
+		} else {
+			snat_issmall(res) = 0;
+			snatneg(res) = (bool)(flptnos[no(arg)].sign == -1);
+			flptnos[no(arg)].sign = 1;
+			snatint(res) = no(arg);
+			return res;
+		}
+	}
+	if (name(arg) == name_tag && !isvar(son(arg))) {
+		res = f_computed_signed_nat(son(son(arg)));
+		kill_exp(arg, arg);
+		return res;
+	}
-  failer(ILLCOMPSNAT);
+	failer(ILLCOMPSNAT);
-  snat_issmall(res) = 1;
+	snat_issmall(res) = 1;
-  snatneg(res) = 0;
+	snatneg(res) = 0;
-  snatint(res) = 1;
+	snatint(res) = 1;
+	return res;
+}
+signed_nat
+f_snat_from_nat(bool neg, nat n)
+{
+	signed_nat res;
+	if (snat_issmall(n)) {
+		snatneg(res) = (bool)((natint(n) == 0) ? 0 : neg);
+		snat_issmall(res) = 1;
+		snatint(res) = natint(n);
-  return res;
+		return res;
+	}
+	snat_issmall(res) = 0;
+	snatbig(res) = natbig(n);
+	snatneg(res) = neg;
+	return res;
+}
+signed_nat
+f_make_signed_nat(tdfbool neg, tdfint n)
+{
+	return f_snat_from_nat(neg, n);
+}
+void
+init_signed_nat(void)
+{
+	return;
+}
-signed_nat f_snat_from_nat
-    PROTO_N ( (neg, n) )
-    PROTO_T ( bool neg X nat n )
-{
-  signed_nat res;
-  if (snat_issmall(n))  {
-    snatneg(res) = (bool)((natint(n) == 0) ? 0 : neg);
-    snat_issmall(res) = 1;
-    snatint(res) = natint(n);
-    return res;
-  }
-  snat_issmall(res) = 0;
-  snatbig(res) = natbig(n);
-  snatneg(res) = neg;
-  return res;
-}
-signed_nat f_make_signed_nat
-    PROTO_N ( (neg, n) )
-    PROTO_T ( tdfbool neg X tdfint n )
-{
-  return f_snat_from_nat(neg, n);
-}
-void init_signed_nat
-    PROTO_Z ()
-{
-   return;
-}
 signed_nat f_dummy_signed_nat;
 string f_dummy_string;
-void init_string
+void
-    PROTO_Z ()
+init_string(void)
 {
 	return;
+}
-string f_concat_string
+string
-    PROTO_N ( (a1, a2) )
-    PROTO_T ( string a1 X string a2 )
+f_concat_string(string a1, string a2)
+{
 	int i;
- 	string res;
+	string res;
 	if (a1.size != a2.size) {
 		failer("Concatenated strings have different unit size");
+	}
 	res.number = a1.number + a2.number;
 	res.size = a1.size;
-	if (res.size<=8) {
+	if (res.size <= 8) {
-		res.ints.chars = (char*)xcalloc(res.number+1, sizeof(char));
+		res.ints.chars = (char *)xcalloc(res.number + 1, sizeof(char));
-		for (i=0; i<a1.number; i++)
+		for (i = 0; i < a1.number; i++) {
 			res.ints.chars[i] = a1.ints.chars[i];
+		}
-		for (i=0; i<a2.number; i++)
+		for (i = 0; i < a2.number; i++) {
-			res.ints.chars[i+a1.number] = a2.ints.chars[i];
+			res.ints.chars[i + a1.number] = a2.ints.chars[i];
-		res.ints.chars[res.number]=0;
-	}
+		}
-	else
+		res.ints.chars[res.number] = 0;
-	if (res.size<=16) {
+	} else if (res.size <= 16) {
-		res.ints.shorts = (short*)xcalloc(res.number+1, sizeof(short));
+		res.ints.shorts = (short *)xcalloc(res.number + 1,
+						   sizeof(short));
-		for (i=0; i<a1.number; i++)
+		for (i = 0; i < a1.number; i++) {
 			res.ints.shorts[i] = a1.ints.shorts[i];
+		}
-		for (i=0; i<a2.number; i++)
+		for (i = 0; i < a2.number; i++) {
-			res.ints.shorts[i+a1.number] = a2.ints.shorts[i];
+			res.ints.shorts[i + a1.number] = a2.ints.shorts[i];
+		}
-		res.ints.shorts[res.number]=0;
+		res.ints.shorts[res.number] =0;
-	}
-	else {
+	} else {
-		res.ints.longs = (int*)xcalloc(res.number+1, sizeof(int));
+		res.ints.longs = (int *)xcalloc(res.number + 1, sizeof(int));
-		for (i=0; i<a1.number; i++)
+		for (i = 0; i < a1.number; i++) {
 			res.ints.longs[i] = a1.ints.longs[i];
+		}
-		for (i=0; i<a2.number; i++)
+		for (i = 0; i < a2.number; i++) {
-			res.ints.longs[i+a1.number] = a2.ints.longs[i];
+			res.ints.longs[i + a1.number] = a2.ints.longs[i];
+		}
-		res.ints.longs[res.number]=0;
+		res.ints.longs[res.number] =0;
 	}
 	return res;
 }
-string f_make_string
+string
-    PROTO_N ( (s) )
-    PROTO_T ( tdfstring s )
+f_make_string(tdfstring s)
 {
 	return s;
 }
-tagshacc f_make_tagshacc
+tagshacc
-    PROTO_N ( (sha, visible, tg_intro) )
-    PROTO_T ( shape sha X access_option visible X tag tg_intro )
+f_make_tagshacc(shape sha, access_option visible, tag tg_intro)
 {
-  tagshacc res;
+	tagshacc res;
-  res.sha = sha;
+	res.sha = sha;
-  res.visible = visible;
+	res.visible = visible;
-  res.tg = tg_intro;
+	res.tg = tg_intro;
-  return res;
+	return res;
 }
-void init_tagshacc
+void
-    PROTO_Z ()
+init_tagshacc(void)
 {
-  return;
+	return;
 }
 transfer_mode f_dummy_transfer_mode;
-transfer_mode f_add_modes
+transfer_mode
-    PROTO_N ( (md1, md2) )
-    PROTO_T ( transfer_mode md1 X transfer_mode md2 )
+f_add_modes(transfer_mode md1, transfer_mode md2)
 {
-  return md1 | md2;
+	return md1 | md2;
 }
+version
+f_user_info(tdfident t)
+{
-version f_user_info
+	version res;
+	UNUSED(t);
+	res.major_version = MAJOR_VERSION;
+	res.minor_version = MINOR_VERSION;
+	return res;
+}
+variety
+f_var_limits(signed_nat lower_bound, signed_nat upper_bound)
+{
+	unsigned int h;
+	unsigned int l;
+	if (!snat_issmall(lower_bound) || !snat_issmall(upper_bound)) {
+		if (snatneg(lower_bound)) {
+			return s64sh;
+		} else {
+			return u64sh;
+		}
+	}
+	/* normalise the varieties to use only the six standard ones */
+	l = (unsigned int)(snatint(lower_bound));
+	/* these assume the length of unsigned int equals int */
+	h = (unsigned int)(snatint(upper_bound));
+	if (!snatneg(lower_bound)) {
-    PROTO_N ( (t) )
+		if (h <= 255) {
+			return ucharsh;
+		}
+		if (h <= 65535) {
+			return uwordsh;
+		}
+		return ulongsh;
+	}
+	if (l <= 128 && h <= 127) {
+		return scharsh;
+	}
+	if (l<= 32768 && h <= 32767) {
+		return swordsh;
+	}
+	return slongsh;
+}
+variety
-    PROTO_T ( tdfident t )
+f_var_width(bool sig, nat bits)
+{
+	int w = natint(bits);
+	if (sig) {
+		if (w <= 8) {
+			return scharsh;
+		}
+		if (w <= 16) {
-  version res;
+			return swordsh;
+		}
-  UNUSED(t);
+		if (w <= 32) {
-  res.major_version = MAJOR_VERSION;
+			return slongsh;
+		}
+		if (w <= 64) {
+			return s64sh;
+		}
-  res.minor_version = MINOR_VERSION;
+		failer(WIDTH_ERROR);
-  return res;
+		return slongsh;
-}
+	}
-variety f_var_limits
+	if (w <= 8) {
-    PROTO_N ( (lower_bound, upper_bound) )
+		return ucharsh;
-    PROTO_T ( signed_nat lower_bound X signed_nat upper_bound )
-{
+	}
-  unsigned int h;
+	if (w <= 16) {
-  unsigned int l;
+		return uwordsh;
+	}
-  if (!snat_issmall(lower_bound) || !snat_issmall(upper_bound)) {
-    if (snatneg(lower_bound))
+	if (w <= 32) {
-      return s64sh;
+		return ulongsh;
+	}
-    else
+	if (w <= 64) {
-      return u64sh;
+		return u64sh;
-  };
+	}
+	failer(WIDTH_ERROR);
+	return ulongsh;
+}
-    /* normalise the varieties to use only the six standard ones */
-  l = (unsigned int)(snatint(lower_bound));
-		/* these assume the length of unsigned int equals int */
-  h = (unsigned int)(snatint(upper_bound));
-  if (!snatneg(lower_bound))
-   {
-     if (h <= 255)
-       return ucharsh;
-     if (h <= 65535)
-       return uwordsh;
-     return ulongsh;
-   };
-  if (l <= 128 && h <= 127)
-   {
-     return scharsh;
-   };
-  if (l<= 32768 && h <= 32767)
-   {
-     return swordsh;
-   };
-  return slongsh;
-}
-variety f_var_width
-    PROTO_N ( (sig, bits) )
-    PROTO_T ( bool sig X nat bits )
-{
-  int w = natint(bits);
-  if (sig) {
-    if (w <= 8)
-      return scharsh;
-    if (w <= 16)
-      return swordsh;
-    if (w <= 32)
-      return slongsh;
-    if (w <= 64)
-      return s64sh;
-    failer(WIDTH_ERROR);
-    return slongsh;
-  }
-  if (w <= 8)
-    return ucharsh;
-  if (w <= 16)
-    return uwordsh;
-  if (w <= 32)
-    return ulongsh;
-  if (w <= 64)
-    return u64sh;
-  failer(WIDTH_ERROR);
-  return ulongsh;
-}
 void init_variety
-    PROTO_Z ()
+(void)
+{
-  ucharsh = getshape(0, const_al1, const_al1, UCHAR_ALIGN, UCHAR_SZ, ucharhd);
+	ucharsh = getshape(0, const_al1, const_al1, UCHAR_ALIGN, UCHAR_SZ,
+			   ucharhd);
-  scharsh = getshape(1, const_al1, const_al1, SCHAR_ALIGN, SCHAR_SZ, scharhd);
+	scharsh = getshape(1, const_al1, const_al1, SCHAR_ALIGN, SCHAR_SZ,
+			   scharhd);
-  uwordsh = getshape(0, const_al1, const_al1, UWORD_ALIGN, UWORD_SZ, uwordhd);
+	uwordsh = getshape(0, const_al1, const_al1, UWORD_ALIGN, UWORD_SZ,
+			   uwordhd);
-  swordsh = getshape(1, const_al1, const_al1, SWORD_ALIGN, SWORD_SZ, swordhd);
+	swordsh = getshape(1, const_al1, const_al1, SWORD_ALIGN, SWORD_SZ,
+			   swordhd);
-  ulongsh = getshape(0, const_al1, const_al1, ULONG_ALIGN, ULONG_SZ, ulonghd);
+	ulongsh = getshape(0, const_al1, const_al1, ULONG_ALIGN, ULONG_SZ,
+			   ulonghd);
-  slongsh = getshape(1, const_al1, const_al1, SLONG_ALIGN, SLONG_SZ, slonghd);
+	slongsh = getshape(1, const_al1, const_al1, SLONG_ALIGN, SLONG_SZ,
+			   slonghd);
-  u64sh = getshape(0, const_al1, const_al1, U64_ALIGN, U64_SZ, u64hd);
+	u64sh = getshape(0, const_al1, const_al1, U64_ALIGN, U64_SZ, u64hd);
-  s64sh = getshape(1, const_al1, const_al1, S64_ALIGN, S64_SZ, s64hd);
+	s64sh = getshape(1, const_al1, const_al1, S64_ALIGN, S64_SZ, s64hd);
-  return;
+	return;
-}
-variety f_dummy_variety;
-version f_make_version
-    PROTO_N ( (major_version, minor_version) )
-    PROTO_T ( tdfint major_version X tdfint minor_version )
-{
-  version res;
-  res.major_version = natint(major_version);
-  res.minor_version = natint(minor_version);
-  if (res.major_version >= 3)
-    newcode = 1;
-  else
-    newcode = 0;
-  return res;
-}
-version_props f_make_versions
-    PROTO_N ( (version_info) )
-    PROTO_T ( version_props version_info )
-{
-  UNUSED(version_info);
-  return 0;
+}
-exp_list new_exp_list
+variety f_dummy_variety;
+version
+f_make_version(tdfint major_version, tdfint minor_version)
+{
+	version res;
+	res.major_version = natint(major_version);
+	res.minor_version = natint(minor_version);
+	if (res.major_version >= 3) {
+		newcode = 1;
+	} else {
+		newcode = 0;
+	}
+	return res;
+}
+version_props
+f_make_versions(version_props version_info)
+{
-    PROTO_N ( (n) )
+	UNUSED(version_info);
+	return 0;
+}
+exp_list
-    PROTO_T ( int n )
+new_exp_list(int n)
 {
-  exp_list res;
+	exp_list res;
-  UNUSED(n);
+	UNUSED(n);
-  res.number = 0;;
+	res.number = 0;;
-  res.start = nilexp;
+	res.start = nilexp;
-  res.end = nilexp;
+	res.end = nilexp;
-  return res;
+	return res;
 }
-exp_list add_exp_list
+exp_list
-    PROTO_N ( (list, elem, index) )
-    PROTO_T ( exp_list list X exp elem X int index )
+add_exp_list(exp_list list, exp elem, int index)
 {
-  UNUSED(index);
+	UNUSED(index);
-  ++list.number;
+	++list.number;
-  parked(elem) = 1;
+	parked(elem) = 1;
-  if (list.start == nilexp)
+	if (list.start == nilexp) {
-   {
-     list.start = elem;
+		list.start = elem;
-     list.end = elem;
+		list.end = elem;
-     setlast(elem);
+		setlast(elem);
-     bro(elem) = nilexp;
+		bro(elem) = nilexp;
-     return list;
+		return list;
-   };
+	}
-  clearlast(list.end);
+	clearlast(list.end);
-  bro(list.end) = elem;
+	bro(list.end) = elem;
-  list.end = elem;
+	list.end = elem;
-  setlast(elem);
+	setlast(elem);
-  bro(elem) = nilexp;
+	bro(elem) = nilexp;
-  return list;
+	return list;
 }
-caselim_list new_caselim_list
+caselim_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
+new_caselim_list(int n)
 {
-  UNUSED(n);
+	UNUSED(n);
-/*  bro(global_case) = nilexp;
+	/*  bro(global_case) = nilexp;
-  return 0;
+	    return 0;
-*/
+	 */
-  return nilexp;
+	return nilexp;
+}
-caselim_list add_caselim_list
+caselim_list
-    PROTO_N ( (list, elem, index) )
-    PROTO_T ( caselim_list list X caselim elem X int index )
+add_caselim_list(caselim_list list, caselim elem, int index)
+{
-       /* see the documentation for the representation of cases */
+	/* see the documentation for the representation of cases */
-     exp ht;
+	exp ht;
-     int  low;
+	int  low;
-     int  high;
+	int  high;
-     exp lowval = getexp (slongsh, nilexp, 0, nilexp, nilexp, 0, 0, 0);
+	exp lowval = getexp(slongsh, nilexp, 0, nilexp, nilexp, 0, 0, 0);
-/*     UNUSED(list);
+	/* UNUSED(list); */
-*/
-     UNUSED(index);
+	UNUSED(index);
-     pt(lowval) = get_lab(elem.lab);	/* label for this branch */
+	pt(lowval) = get_lab(elem.lab);	/* label for this branch */
+	if (snat_issmall(elem.low)) {
+		low = snatint(elem.low);
+		if (snatneg(elem.low)) {
+			low = - low;
+		}
+	} else {
+#if !has64bits
+		SET(low);
+		failer(TOO_BIG_A_CASE_ELEMENT);
+#else
+		low = snatbig(elem.low);
+		if (snatneg(elem.low)) {
+			flpt z = new_flpt();
+			flt_copy(flptnos[low], &flptnos[z]);
+			low = z;
+			flptnos[low].sign = - flptnos[low].sign;
+		}
+		setbigval(lowval);
+#endif
+	}
+	no(lowval) = low;
-     if (snat_issmall(elem.low)){
+	if (snat_issmall(elem.high)) {
-       low = snatint(elem.low);
+		high = snatint(elem.high);
-       if (snatneg(elem.low))
+		if (snatneg(elem.high)) {
+			high = - high;
+		}
+		if (!isbigval(lowval) && high == low) {
+			ht = nilexp;
+		} else {
+			ht = getexp(slongsh, nilexp, 1, nilexp, nilexp, 0,
-         low = - low;
+				    high, 0);
-     }
+		}
-     else {
+	} else {
 #if !has64bits
-       SET(low);
+		SET(ht);
-       failer(TOO_BIG_A_CASE_ELEMENT);
+		failer(TOO_BIG_A_CASE_ELEMENT);
 #else
+		int lh_eq;
-       low = snatbig(elem.low);
+		high = snatbig(elem.high);
-       if (snatneg(elem.low)) {
+		if (snatneg(elem.high)) {
-	 flpt z = new_flpt();
+			flpt z = new_flpt();
-	 flt_copy(flptnos[low], &flptnos[z]);
+			flt_copy(flptnos[high], &flptnos[z]);
-	 low = z;
+			high = z;
-	 flptnos[low].sign = - flptnos[low].sign;
+			flptnos[high].sign = - flptnos[high].sign;
-       }
+		}
-       setbigval(lowval);
+		if (isbigval(lowval)) {
+			lh_eq = flt_cmp(flptnos[low], flptnos[high]);
-#endif
+		} else {
-     };
+			lh_eq = 0;
-     no(lowval) = low;
+		}
-     if (snat_issmall(elem.high)) {
-       high = snatint(elem.high);
-       if (snatneg(elem.high))
-         high = - high;
-       if (!isbigval(lowval) && high == low)
-	   ht = nilexp;
-       else
-	   ht = getexp (slongsh, nilexp, 1, nilexp, nilexp, 0, high, 0);
-     }
-     else {
-#if !has64bits
-       SET(ht);
-       failer(TOO_BIG_A_CASE_ELEMENT);
-#else
-       int lh_eq;
-       high = snatbig(elem.high);
-       if (snatneg(elem.high)) {
-	 flpt z = new_flpt();
-	 flt_copy(flptnos[high], &flptnos[z]);
-	 high = z;
-	 flptnos[high].sign = - flptnos[high].sign;
-       }
-       if (isbigval(lowval)) {
-         lh_eq = flt_cmp(flptnos[low], flptnos[high]);
-       }
-       else
-	 lh_eq = 0;
-       if (!lh_eq) {
+		if (!lh_eq) {
-	   ht = getexp (slongsh, nilexp, 1, nilexp, nilexp, 0,
+			ht = getexp(slongsh, nilexp, 1, nilexp, nilexp, 0,
-			 high, 0);
+				    high, 0);
-	   setbigval(ht);
+			setbigval(ht);
-       }
-       else
+		} else {
-	   ht = nilexp;
+			ht = nilexp;
+		}
 #endif
-     };
+	}
-/*     if (ht != nilexp && docmp_f((int)f_less_than, ht, lowval)){
+	/*     if (ht != nilexp && docmp_f((int)f_less_than, ht, lowval)){
-	 retcell(lowval);
+	       retcell(lowval);
-	 retcell(ht);
+	       retcell(ht);
-	 return 0;
+	       return 0;
-     }
+	       }
-*/
+	 */
-     ++no (son (pt(lowval)));	/* record label use */
+	++no(son(pt(lowval)));	/* record label use */
-     son(lowval) = ht;
+	son(lowval) = ht;
- /*    case_item (lowval);
+	/*    case_item (lowval);
-*/
+	 */
-     bro(lowval) = list;
+	bro(lowval) = list;
-     return lowval;
+	return lowval;
 }
-label_list new_label_list
+label_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
+new_label_list(int n)
 {
-  label_list res;
+	label_list res;
-  res.elems = (label *)xcalloc(n, sizeof(label));
+	res.elems = (label *)xcalloc(n, sizeof(label));
-  res.number = n;
+	res.number = n;
-  return res;
+	return res;
 }
-label_list add_label_list
+label_list
-    PROTO_N ( (list, elem, index) )
-    PROTO_T ( label_list list X label elem X int index )
+add_label_list(label_list list, label elem, int index)
 {
-    exp def;
+	exp def;
-    exp labst;
+	exp labst;
-    def = getexp (f_top, nilexp, 0, nilexp, nilexp, 0, 0,
+	def = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, clear_tag);
-                    clear_tag);
-    labst = getexp (f_bottom, nilexp, 0, def, nilexp, 0, 0,
+	labst = getexp(f_bottom, nilexp, 0, def, nilexp, 0, 0, labst_tag);
-                        labst_tag);
-    fno(labst) = default_freq;
+	fno(labst) = default_freq;
-    ++proc_label_count;
+	++proc_label_count;
-    set_lab(elem, labst);
+	set_lab(elem, labst);
-    list.elems[index] = elem;
+	list.elems[index] = elem;
-    return list;
+	return list;
 }
-tagshacc_list new_tagshacc_list
+tagshacc_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
+new_tagshacc_list(int n)
 {
-  tagshacc_list res;
+	tagshacc_list res;
-  res.size = 0;
+	res.size = 0;
-  res.id = nilexp;
+	res.id = nilexp;
-  res.last_id = nilexp;
+	res.last_id = nilexp;
-  res.last_def = nilexp;
+	res.last_def = nilexp;
-  res.number = n;
+	res.number = n;
-  return res;
+	return res;
 }
-tagshacc_list add_tagshacc_list
+tagshacc_list
-    PROTO_N ( (list, elem, index) )
-    PROTO_T ( tagshacc_list list X tagshacc elem X int index )
+add_tagshacc_list(tagshacc_list list, tagshacc elem, int index)
 {
-  exp d = getexp(elem.sha, nilexp, 0, nilexp, nilexp, 0, 0, clear_tag);
+	exp d = getexp(elem.sha, nilexp, 0, nilexp, nilexp, 0, 0, clear_tag);
-  exp i = getexp(f_bottom, list.last_id, 1, d, nilexp, 0, 0, ident_tag);
+	exp i = getexp(f_bottom, list.last_id, 1, d, nilexp, 0, 0, ident_tag);
-  UNUSED(index);
+	UNUSED(index);
-  set_tag(elem.tg, i);
+	set_tag(elem.tg, i);
-  if (list.id == nilexp)
+	if (list.id == nilexp) {
-    list.id = i;
+		list.id = i;
-  else
+	} else {
-    bro(list.last_def) = i;
+		bro(list.last_def) = i;
+	}
-  list.last_def = d;
+	list.last_def = d;
-  list.last_id = i;
+	list.last_id = i;
-  if (elem.visible & (f_visible | f_long_jump_access))
+	if (elem.visible & (f_visible | f_long_jump_access)) {
-    setvis(i);
+		setvis(i);
+	}
-  if (elem.visible & f_out_par)
+	if (elem.visible & f_out_par) {
-	setoutpar(i);
+		setoutpar(i);
+	}
-  setvar(i);
+	setvar(i);
-  setparam(i);
+	setparam(i);
-  return list;
+	return list;
 }
-version_list new_version_list
+version_list
-    PROTO_N ( (n) )
-    PROTO_T ( int n )
+new_version_list(int n)
+{
-  UNUSED(n);
+	UNUSED(n);
-  return 0;
+	return 0;
+}
 static int version_printed = 0;
-version_list add_version_list
+version_list
-    PROTO_N ( (list, elem, index) )
-    PROTO_T ( version_list list X version elem X int index )
+add_version_list(version_list list, version elem, int index)
 {
+	UNUSED(list);
-  UNUSED(list); UNUSED(index);
+	UNUSED(index);
-  if (global_version.major_version == 0)
+	if (global_version.major_version == 0) {
-    global_version = elem;
+		global_version = elem;
+	}
-  if (elem.major_version != global_version.major_version)  {
+	if (elem.major_version != global_version.major_version) {
-    failer(WRONG_VERSION);
+		failer(WRONG_VERSION);
-    IGNORE fprintf(stderr, "This TDF has mixed versions\n");
+		IGNORE fprintf(stderr, "This TDF has mixed versions\n");
-  };
+	}
-  if (report_versions) {
+	if (report_versions) {
-    if (!version_printed) {
+		if (!version_printed) {
-      version_printed = 1;
+			version_printed = 1;
-      IGNORE fprintf(stderr, "This TDF is composed from Capsules of the following versions:-\n");
+			IGNORE fprintf(stderr, "This TDF is composed from Capsules of the following versions:-\n");
-    };
+		}
-    IGNORE fprintf(stderr, "TDF Version %d.%d\n",
+		IGNORE fprintf(stderr, "TDF Version %d.%d\n",
-		 elem.major_version, elem.minor_version);
+			       elem.major_version, elem.minor_version);
-  };
+	}
-  return 0;
+	return 0;
 }
 version f_dummy_version;
 access_option no_access_option = 0;
-access_option yes_access_option
+access_option
-    PROTO_N ( (acc) )
-    PROTO_T ( access acc )
+yes_access_option(access acc)
 {
-  return acc;
+	return acc;
 }
 string_option no_string_option;
-string_option yes_string_option
+string_option
-    PROTO_N ( (s) )
-    PROTO_T ( string s )
+yes_string_option(string s)
+{
- 	string_option res;
+	string_option res;
 	res.val = s;
 	res.present = 1;
-  	return res;
+	return res;
+}
+void
-void init_string_option
+init_string_option(void)
-    PROTO_Z ()
+{
 	no_string_option.present = 0;
+}
 tagacc_option no_tagacc_option;
-tagacc_option yes_tagacc_option
+tagacc_option
-    PROTO_N ( (elem) )
-    PROTO_T ( tagacc elem )
+yes_tagacc_option(tagacc elem)
+{
-  tagacc_option res;
+	tagacc_option res;
-  res.val = elem;
+	res.val = elem;
-  res.present = 1;
+	res.present = 1;
-  return res;
+	return res;
 }
+void
-void init_tagacc_option
+init_tagacc_option(void)
-    PROTO_Z ()
 {
-  no_tagacc_option.present = 0;
+	no_tagacc_option.present = 0;
-  return;
+	return;
 }
 nat_option no_nat_option;
-nat_option yes_nat_option
+nat_option
-    PROTO_N ( (n) )
-    PROTO_T ( nat n )
+yes_nat_option(nat n)
 {
-  nat_option res;
+	nat_option res;
-  res.val = n;
+	res.val = n;
-  res.present = 1;
+	res.present = 1;
-  return res;
+	return res;
 }
+void
-void init_nat_option
+init_nat_option(void)
-    PROTO_Z ()
 {
-  no_nat_option.present = 0;
+	no_nat_option.present = 0;
-  return;
+	return;
 }
-void init_tagacc
+void
-    PROTO_Z ()
+init_tagacc(void)
 {
-  return;
+	return;
 }
-tagacc f_make_tagacc
+tagacc
-    PROTO_N ( (tg, acc) )
-    PROTO_T ( tag tg X access_option acc )
+f_make_tagacc(tag tg, access_option acc)
 {
-  tagacc res;
+	tagacc res;
-  res.tg = tg;
+	res.tg = tg;
-  res.visible = acc;
+	res.visible = acc;
-  return res;
+	return res;
 }
+void
-void init_transfer_mode
+init_transfer_mode(void)
-    PROTO_Z ()
 {
-  return;
+	return;
 }
+void
-void init_version_props
+init_version_props(void)
-    PROTO_Z ()
 {
-  global_version.major_version = 0;
+	global_version.major_version = 0;
-  global_version.minor_version = 0;
+	global_version.minor_version = 0;
-  return;
+	return;
 }
-void init_version
+void
-    PROTO_Z ()
+init_version(void)
+{
-  return;
+	return;
+}
+void
-void init_access_option
+init_access_option(void)
-    PROTO_Z ()
+{
-  return;
+	return;
+}
 static int seq_n = 0;
-char * init_NAME
+char *
-    PROTO_N ( (good_name) )
-    PROTO_T ( char * good_name )
+init_NAME(char *good_name)
+{
-   char * prefix  = "__I.TDF";
+	char *prefix  = "__I.TDF";
-   time_t t;
+	time_t t;
-   int i,j;
+	int i, j;
-   char * c;
+	char *c;
-   char * res;
+	char *res;
+	int sc;
+	int sp;
-   int sc; int sp; int sg;
+	int sg;
-   t = time(NULL) + (time_t)(seq_n++);
+	t = time(NULL) + (time_t)(seq_n++);
-   c = asctime(localtime(&t));
+	c = asctime(localtime(&t));
+	sc = (int)strlen(c);
+	sp = (int)strlen(prefix);
-   sc = (int)strlen(c); sp = (int)strlen(prefix); sg = (int)strlen(good_name);
+	sg = (int)strlen(good_name);
-   res = (char*)xcalloc(sc+sp+sg, sizeof(char));
+	res = (char*)xcalloc(sc + sp + sg, sizeof(char));
+	for (i = 0; i < sp; i++) {
-   for(i=0; i<sp; i++) res[i] = prefix[i];
+		res[i] = prefix[i];
+	}
-   for(j=0; j<sg; i++, j++) res[i] = good_name[j];
+	for (j = 0; j < sg; i++, j++) {
+		res[i] = good_name[j];
+	}
-   for(j=0; j<sc; j++) {
+	for (j = 0; j < sc; j++) {
-	if(isalpha(c[j])|| isdigit(c[j]) ){ res[i] = c[j]; i++;}
+		if (isalpha(c[j]) || isdigit(c[j])) {
+			res[i] = c[j]; i++;
-   }
+		}
+	}
-   res[i] = 0;
+	res[i] = 0;
-   dynamic_init_proc = res;
+	dynamic_init_proc = res;
-   return(res);
+	return (res);
 }
+void
-void start_initial_value
+start_initial_value(void)
-    PROTO_Z ()
 {
-   if (in_initial_value++ == 0) {
+	if (in_initial_value++ == 0) {
-	proc_props * real_pp = (proc_props*)0;
+		proc_props *real_pp = (proc_props *)0;
-	if (old_proc_props != (proc_props*)0) {
+		if (old_proc_props != (proc_props *)0) {
-		/* initial value in proc */
+			/* initial value in proc */
-		push_proc_props();
+			push_proc_props();
-		real_pp = old_proc_props;
+			real_pp = old_proc_props;
-	}
+		}
-	old_proc_props = &initial_value_pp;
+		old_proc_props = &initial_value_pp;
-	pop_proc_props();
+		pop_proc_props();
-	old_proc_props = real_pp;
+		old_proc_props = real_pp;
-   }
+	}
+}
-}
-exp f_initial_value
+exp
-    PROTO_N ( (e) )
-    PROTO_T ( exp e )
+f_initial_value(exp e)
+{
-   	if (--in_initial_value > 0) return e;
+	if (--in_initial_value > 0) {
+		return e;
+	}
-  	initial_value_pp.proc_struct_result = proc_struct_result;
+	initial_value_pp.proc_struct_result = proc_struct_result;
-  	initial_value_pp.has_alloca = has_alloca;
+	initial_value_pp.has_alloca = has_alloca;
-  	initial_value_pp.proc_is_recursive = proc_is_recursive;
+	initial_value_pp.proc_is_recursive = proc_is_recursive;
-  	initial_value_pp.uses_crt_env = uses_crt_env;
+	initial_value_pp.uses_crt_env = uses_crt_env;
-  	initial_value_pp.has_setjmp = has_setjmp;
+	initial_value_pp.has_setjmp = has_setjmp;
-  	initial_value_pp.uses_loc_address = uses_loc_address;
+	initial_value_pp.uses_loc_address = uses_loc_address;
-  	initial_value_pp.proc_label_count = proc_label_count;
+	initial_value_pp.proc_label_count = proc_label_count;
-  	initial_value_pp.proc_struct_res = proc_struct_res;
+	initial_value_pp.proc_struct_res = proc_struct_res;
-  	initial_value_pp.default_freq = default_freq;
+	initial_value_pp.default_freq = default_freq;
-  	initial_value_pp.proc_externs = proc_externs;
+	initial_value_pp.proc_externs = proc_externs;
-  	initial_value_pp.in_proc_def = in_proc_def;
+	initial_value_pp.in_proc_def = in_proc_def;
-  	initial_value_pp.pushed = old_proc_props;
+	initial_value_pp.pushed = old_proc_props;
-  	initial_value_pp.rep_make_proc = rep_make_proc;
+	initial_value_pp.rep_make_proc = rep_make_proc;
-	if (old_proc_props != (proc_props*)0) {
+	if (old_proc_props != (proc_props *)0) {
 		/* init was in a proc - must make new variable */
-		dec * my_def = make_extra_dec(make_local_name(), 1, 0,
+		dec *my_def = make_extra_dec(make_local_name(), 1, 0, me_u2(e,
-						me_u2(e, initial_value_tag), sh(e) );
+					     initial_value_tag), sh(e));
-		exp crt_exp = my_def -> dec_u.dec_val.dec_exp;
+		exp crt_exp = my_def->dec_u.dec_val.dec_exp;
 		pop_proc_props();
 		return f_contents(sh(e), me_obtain(crt_exp));
+	}
 	return me_u2(e, initial_value_tag);
+}
+void
-void tidy_initial_values
+tidy_initial_values(void)
-    PROTO_Z ()
+{
-   dec * my_def = top_def;
+	dec *my_def = top_def;
-   exp_list initial_as;
+	exp_list initial_as;
-   exp_list prom_as;
+	exp_list prom_as;
-   char * good_name = (char*)0;
+	char *good_name = (char *)0;
-   initial_as = new_exp_list(0);
+	initial_as = new_exp_list(0);
-   prom_as = new_exp_list(0);
+	prom_as = new_exp_list(0);
-   dynamic_init_proc = (char*) 0;
+	dynamic_init_proc = (char *)0;
-   while (my_def != (dec*)0){
+	while (my_def != (dec *)0) {
-	exp crt_exp = my_def -> dec_u.dec_val.dec_exp;
+		exp crt_exp = my_def->dec_u.dec_val.dec_exp;
-	if (son(crt_exp) != nilexp && my_def -> dec_u.dec_val.extnamed) {
+		if (son(crt_exp) != nilexp && my_def->dec_u.dec_val.extnamed) {
-		good_name = my_def -> dec_u.dec_val.dec_id;
-	}
-	if (son(crt_exp) != nilexp && name(son(crt_exp)) == initial_value_tag) {
-		/* accumulate assignments of initial values in one explist */
-		if (!(my_def -> dec_u.dec_val.dec_var)) { /* make sure its a variable */
-		    exp p = pt(crt_exp);
-		    setvar(crt_exp);
-		    my_def -> dec_u.dec_val.dec_var = 1;
-		    while(p != nilexp){
-			    exp np = pt(p);
-			    exp c =
-				hold_check(f_contents(sh(p), me_obtain(crt_exp)));
-			    replace(p, c ,nilexp);
-			    p = np;
-		    }
-		}
-	       {exp init = son(son(crt_exp));
-		exp new_init = f_make_value(sh(init));
-	        if (good_name == (char*)0) {
-			good_name = my_def -> dec_u.dec_val.dec_id;
+			good_name = my_def->dec_u.dec_val.dec_id;
+		}
+		if (son(crt_exp) != nilexp &&
+		    name(son(crt_exp)) == initial_value_tag) {
+			/* accumulate assignments of initial values in one
+			   explist */
+			if (!(my_def->dec_u.dec_val.dec_var)) {
+				/* make sure its a variable */
+				exp p = pt(crt_exp);
+				setvar(crt_exp);
+				my_def->dec_u.dec_val.dec_var = 1;
+				while (p != nilexp) {
+					exp np = pt(p);
+					exp c = hold_check(f_contents(sh(p),
+							   me_obtain(crt_exp)));
+					replace(p, c, nilexp);
+					p = np;
+				}
+			}
+			{
+				exp init = son(son(crt_exp));
+				exp new_init = f_make_value(sh(init));
+				if (good_name == (char *)0) {
+					good_name =
+					    my_def->dec_u.dec_val.dec_id;
+				}
-		retcell(son(crt_exp));
+				retcell(son(crt_exp));
-		son(crt_exp) = new_init;
+				son(crt_exp) = new_init;
-		bro(new_init) = crt_exp; setlast(new_init);
+				bro(new_init) = crt_exp; setlast(new_init);
-		initial_as = add_exp_list(initial_as,
+				initial_as = add_exp_list(initial_as,
-			hold_check(f_assign(me_obtain(crt_exp), init)), 0);
+				    hold_check(f_assign(me_obtain(crt_exp),
+							init)), 0);
+			}
+		}
+		if (do_prom && son(crt_exp) != nilexp &&
+		    my_def->dec_u.dec_val.dec_var && !is_comm(son(crt_exp))) {
+			/* accumulate assignments of non-zero initialisations
+			   in one explist */
+			exp init = son(crt_exp);
+			exp new_init = f_make_value(sh(init));
+			if (good_name == (char *)0) {
+				good_name = my_def->dec_u.dec_val.dec_id;
+			}
+			if (name(init) == compound_tag ||
+			    name(init) == nof_tag ||
+			    name(init) == concatnof_tag ||
+			    name(init) == ncopies_tag ||
+			    name(init) == string_tag) {
+				dec *id_dec = make_extra_dec(make_local_name(),
+, 0, init,
+							     sh(init));
+				init = me_obtain(id_dec->dec_u.dec_val.dec_exp);
+			}
+			son(crt_exp) = new_init;
+			no(new_init) = -1; /* we may need to distinguish for
+					      diags */
+			bro(new_init) = crt_exp;
+			setlast(new_init);
+			prom_as = add_exp_list(prom_as,
+					       hold_check(f_assign(me_obtain(
+							  crt_exp), init)), 0);
+		}
+		my_def = my_def->def_next;
+	}
+	if (initial_as.number != 0) {
+		/* ie there are some dynamic initialisations */
+		exp prc;
+		dec *extra_dec;
+		tagshacc_list tsl;
+		exp ret = f_return(f_make_top());
+		exp seq = f_sequence(initial_as, ret);
+		tsl = new_tagshacc_list(0);
-	if (do_prom && son(crt_exp) != nilexp && my_def -> dec_u.dec_val.dec_var
+		old_proc_props = &initial_value_pp;  pop_proc_props();
-				&& !is_comm (son(crt_exp))) {
+		old_proc_props = (proc_props *)0;
+		rep_make_proc = 0;
+		push_proc_props();
+		prc = f_make_proc(f_top, tsl, no_tagacc_option, seq);
-		/* accumulate assignments of non-zero initialisations in one explist */
+		/* prc has one visible param - hence looks like varargs */
+		if (do_prom) {
-		exp init = son(crt_exp);
+			/* struct (proc, ptr) */
+			exp off_proc = hold_check(f_offset_zero(PROC_ALIGN));
+			exp off_ptr = hold_check(f_offset_pad(PTR_ALIGN,
+						 hold_check(f_offset_add(copy(
+						 off_proc), hold_check(
+						 f_shape_offset(f_proc))))));
+			shape str_sh = f_compound(hold_check(f_offset_add(copy(
+						  off_ptr), hold_check(
+						  f_shape_offset(f_pointer(
+						  PROC_ALIGN))))));
+			dec *str_dec = make_extra_dec(make_local_name(), 1, 0,
-		exp new_init = f_make_value(sh(init));
+						      f_make_value(str_sh),
+						      str_sh);
+			dec *prc_dec = make_extra_dec(make_local_name(), 0, 0,
-	        if (good_name == (char*)0) {
+						      prc, f_proc);
+			exp prc_exp = prc_dec->dec_u.dec_val.dec_exp;
-			good_name = my_def -> dec_u.dec_val.dec_id;
+			exp str_exp = str_dec->dec_u.dec_val.dec_exp;
+			exp list_exp = find_named_tg("__PROM_init_list",
+						     f_pointer(f_alignment(
+						     str_sh)));
+			brog(list_exp)->dec_u.dec_val.dec_var = 1;
+			setvar(list_exp);
+			prom_as = add_exp_list(prom_as, hold_check(f_assign(
+					       f_add_to_ptr(me_obtain(str_exp),
+							    copy(off_proc)),
+					       me_obtain(prc_exp))), 0);
+			prom_as = add_exp_list(prom_as, hold_check(f_assign(
+					       f_add_to_ptr(me_obtain(str_exp),
+							    copy(off_ptr)),
+					       f_contents(sh(list_exp),
+					       me_obtain(list_exp)))), 0);
+			prom_as = add_exp_list(prom_as, hold_check(f_assign(
+					       me_obtain(list_exp),
+					       me_obtain(str_exp))), 0);
+		} else {
+			extra_dec = make_extra_dec(add_prefix(init_NAME(
+						   good_name)), 0, 1, prc,
+						   f_proc);
+		}
-		if (name(init) == compound_tag || name(init) == nof_tag ||
-			name(init) == concatnof_tag || name(init) == ncopies_tag ||
-			name(init) == string_tag) {
-		  dec * id_dec = make_extra_dec (make_local_name(), 0, 0, init, sh(init));
-		  init = me_obtain(id_dec -> dec_u.dec_val.dec_exp);
-		}
-		son(crt_exp) = new_init;
-		no(new_init) = -1;	/* we may need to distinguish for diags */
-		bro(new_init) = crt_exp; setlast(new_init);
-		prom_as = add_exp_list(prom_as,
-			hold_check(f_assign(me_obtain(crt_exp), init)), 0);
+	}
-	my_def = my_def->def_next;
+	if (do_prom && prom_as.number != 0) {
-   }
-   if (initial_as.number != 0) { /* ie there are some dynamic initialisations */
+		/* ie there are some prom initialisations */
-	exp prc;
+		exp prc;
-	dec * extra_dec;
+		dec *extra_dec;
-	tagshacc_list tsl;
+		tagshacc_list tsl;
-	exp ret = f_return(f_make_top());
-	exp seq = f_sequence(initial_as, ret);
-	tsl = new_tagshacc_list(0);
-	old_proc_props = &initial_value_pp;  pop_proc_props();
+		exp ret = f_return(f_make_top());
-	old_proc_props = (proc_props*)0; rep_make_proc = 0; push_proc_props();
+		exp seq = f_sequence(prom_as, ret);
-	prc = f_make_proc(f_top, tsl, no_tagacc_option, seq);
+		tsl = new_tagshacc_list(0);
-		/* prc has one visible param - hence looks like varargs */
-	if (do_prom) {
-		/* struct (proc, ptr) */
+		rep_make_proc = 0;
-	  exp off_proc = hold_check (f_offset_zero (PROC_ALIGN));
-	  exp off_ptr = hold_check (f_offset_pad (PTR_ALIGN,
-			hold_check (f_offset_add (copy (off_proc),
+		start_make_proc(f_top, tsl, no_tagacc_option);
-				hold_check (f_shape_offset (f_proc))))));
+		prc = f_make_proc(f_top, tsl, no_tagacc_option, seq);
-	  shape str_sh = f_compound (hold_check (f_offset_add (copy (off_ptr),
-				hold_check (f_shape_offset (f_pointer (PROC_ALIGN))))));
-	  dec * str_dec = make_extra_dec (make_local_name(), 1, 0,
+		extra_dec = make_extra_dec(add_prefix(init_NAME(good_name)), 0,
-				f_make_value (str_sh), str_sh);
-	  dec * prc_dec = make_extra_dec(make_local_name(), 0, 0, prc, f_proc);
-	  exp prc_exp = prc_dec -> dec_u.dec_val.dec_exp;
-	  exp str_exp = str_dec -> dec_u.dec_val.dec_exp;
-	  exp list_exp = find_named_tg ("__PROM_init_list", f_pointer (f_alignment (str_sh)));
-	  brog(list_exp) -> dec_u.dec_val.dec_var = 1;
-          setvar(list_exp);
-	  prom_as = add_exp_list (prom_as,
-		hold_check (f_assign (f_add_to_ptr (me_obtain(str_exp), copy (off_proc)),
-				me_obtain(prc_exp))), 0);
+, prc, f_proc);
-	  prom_as = add_exp_list (prom_as,
-		hold_check (f_assign (f_add_to_ptr (me_obtain(str_exp), copy (off_ptr)),
-	  			f_contents (sh(list_exp), me_obtain(list_exp)))), 0);
-	  prom_as = add_exp_list (prom_as,
-		hold_check (f_assign (me_obtain(list_exp), me_obtain(str_exp))), 0);
+	}
-	else
-	  extra_dec = make_extra_dec(add_prefix(init_NAME(good_name)), 0, 1, prc, f_proc);
-    }
-   if (do_prom && prom_as.number != 0) { /* ie there are some prom initialisations */
-	exp prc;
-	dec * extra_dec;
-	tagshacc_list tsl;
-	exp ret = f_return(f_make_top());
-	exp seq = f_sequence(prom_as, ret);
-	tsl = new_tagshacc_list(0);
-	rep_make_proc = 0;
-	start_make_proc(f_top, tsl, no_tagacc_option);
-	prc = f_make_proc(f_top, tsl, no_tagacc_option, seq);
-	extra_dec = make_extra_dec(add_prefix(init_NAME(good_name)), 0, 1, prc, f_proc);
-    }
+}

Subversion Repositories tendra.SVN

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