WebSVN – tendra.SVN – Blame – /branches/tendra5-amd64/src/installers/common/construct/install_fns.c

Rev	Author	Line No.	Line
2	7u83	1	`/*`
6	7u83	2	`* Copyright (c) 2002-2006 The TenDRA Project <http://www.tendra.org/>.`
		3	`* All rights reserved.`
		4	`*`
		5	`* Redistribution and use in source and binary forms, with or without`
		6	`* modification, are permitted provided that the following conditions are met:`
		7	`*`
		8	`* 1. Redistributions of source code must retain the above copyright notice,`
		9	`* this list of conditions and the following disclaimer.`
		10	`* 2. Redistributions in binary form must reproduce the above copyright notice,`
		11	`* this list of conditions and the following disclaimer in the documentation`
		12	`* and/or other materials provided with the distribution.`
		13	`* 3. Neither the name of The TenDRA Project nor the names of its contributors`
		14	`* may be used to endorse or promote products derived from this software`
		15	`* without specific, prior written permission.`
		16	`*`
		17	* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
		18	`* IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,`
		19	`* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR`
		20	`* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR`
		21	`* CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,`
		22	`* EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,`
		23	`* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;`
		24	`* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,`
		25	`* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR`
		26	`* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF`
		27	`* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.`
		28	`*`
		29	`* $Id$`
		30	`*/`
		31	`/*`
2	7u83	32	`Crown Copyright (c) 1997`
		33
		34	`This TenDRA(r) Computer Program is subject to Copyright`
		35	`owned by the United Kingdom Secretary of State for Defence`
		36	`acting through the Defence Evaluation and Research Agency`
		37	`(DERA). It is made available to Recipients with a`
		38	`royalty-free licence for its use, reproduction, transfer`
		39	`to other parties and amendment for any purpose not excluding`
		40	`product development provided that any such use et cetera`
		41	`shall be deemed to be acceptance of the following conditions:-`
		42
		43	`(1) Its Recipients shall ensure that this Notice is`
		44	`reproduced upon any copies or amended versions of it;`
		45
		46	`(2) Any amended version of it shall be clearly marked to`
		47	`show both the nature of and the organisation responsible`
		48	`for the relevant amendment or amendments;`
		49
		50	`(3) Its onward transfer from a recipient to another`
		51	`party shall be deemed to be that party's acceptance of`
		52	`these conditions;`
		53
		54	`(4) DERA gives no warranty or assurance as to its`
		55	`quality or suitability for any purpose and DERA accepts`
		56	`no liability whatsoever in relation to any use to which`
		57	`it may be put.`
		58	`*/`
		59
		60
		61	`/**********************************************************************`
		62	$Author: pwe $
		63	$Date: 1998/03/17 16:34:56 $
		64	$Revision: 1.3 $
		65	$Log: install_fns.c,v $
		66	`* Revision 1.3 1998/03/17 16:34:56 pwe`
		67	`* correction for non-NEWDIAGS`
		68	`*`
		69	`* Revision 1.2 1998/03/11 11:03:26 pwe`
		70	`* DWARF optimisation info`
		71	`*`
		72	`* Revision 1.1.1.1 1998/01/17 15:55:47 release`
		73	`* First version to be checked into rolling release.`
		74	`*`
		75	`* Revision 1.89 1998/01/09 09:28:51 pwe`
		76	`* prep restructure`
		77	`*`
		78	`* Revision 1.88 1997/12/04 19:39:04 pwe`
		79	`* ANDF-DE V1.9`
		80	`*`
		81	`* Revision 1.87 1997/11/04 18:23:50 pwe`
		82	`* split install_fns with new flpt_fns`
		83	`*`
		84	`* Revision 1.86 1997/10/23 09:24:32 pwe`
		85	`* extra diags`
		86	`*`
		87	`* Revision 1.85 1997/10/10 18:15:34 pwe`
		88	`* prep ANDF-DE revision`
		89	`*`
		90	`* Revision 1.84 1997/08/23 13:24:16 pwe`
		91	`* no invert order, and NEWDIAGS inlining`
		92	`*`
		93	`* Revision 1.83 1997/08/06 10:58:25 currie`
		94	`* Catch overflowed constants, PlumHall requirement`
		95	`*`
		96	`* Revision 1.82 1997/02/18 12:56:28 currie`
		97	`* NEW DIAG STRUCTURE`
		98	`*`
		99	`* Revision 1.81 1996/11/18 14:36:51 currie`
		100	`* case_opt fixes`
		101	`*`
		102	`* Revision 1.80 1996/11/12 10:42:20 currie`
		103	`* unsigned cases`
		104	`*`
		105	`* Revision 1.78 1996/11/11 10:05:39 currie`
		106	`* current_env on hppa`
		107	`*`
6	7u83	108	`* Revision 1.77 1996/10/29 10:10:46 currie`
		109	`* 512 bit alignment for hppa`
		110	`*`
2	7u83	111	`* Revision 1.76 1996/10/21 08:53:55 currie`
		112	`* long_jump_access`
		113	`*`
6	7u83	114	`* Revision 1.75 1996/10/01 08:59:22 currie`
		115	`* correct chvar exceptions ADA`
		116	`*`
		117	`* Revision 1.74 1996/09/04 14:44:40 currie`
		118	`* mis-spelling`
		119	`*`
		120	`* Revision 1.73 1996/09/04 14:19:55 currie`
		121	`* mis-spelling`
		122	`*`
		123	`* Revision 1.71 1996/07/05 15:45:09 currie`
		124	`* initial values`
		125	`*`
		126	`* Revision 1.70 1996/06/19 11:50:36 currie`
		127	`* Parameter alignments in make_coumpound`
		128	`*`
		129	`* Revision 1.69 1996/06/18 09:20:55 currie`
		130	`* C torture long nats`
		131	`*`
		132	`* Revision 1.68 1996/06/05 15:29:54 currie`
		133	`* parameter alignment in make_cmpd`
		134	`*`
		135	`* Revision 1.67 1996/05/14 10:39:14 currie`
		136	`* Long unsigned div2`
		137	`*`
		138	`* Revision 1.66 1996/05/02 09:34:44 currie`
		139	`* Empty caselim list`
		140	`*`
		141	`* Revision 1.65 1996/04/02 10:34:16 currie`
		142	`* volatile & trap_on_nil`
		143	`*`
2	7u83	144	`* Revision 1.63 1996/03/28 11:33:48 currie`
		145	`* Hppa struct params + outpar+init names`
		146	`*`
		147	`* Revision 1.62 1996/03/12 09:45:20 currie`
		148	`* promote pars`
		149	`*`
		150	`* Revision 1.60 1996/02/28 11:36:20 currie`
		151	`* assign to promoted pars`
		152	`*`
		153	`* Revision 1.59 1996/02/26 11:54:22 currie`
		154	`* Various odds and ends`
		155	`*`
		156	`* Revision 1.58 1996/02/21 09:39:02 currie`
		157	`* hppa var_callers + inlined bug`
		158	`*`
		159	`* Revision 1.57 1996/01/25 17:02:53 currie`
		160	`* Struct params in sparc + postludes`
		161	`*`
		162	`* Revision 1.56 1996/01/22 14:25:33 currie`
		163	`* char parameters on bigendian`
		164	`*`
		165	`* Revision 1.55 1996/01/19 14:49:54 currie`
		166	`* sparc parameter alignments`
		167	`*`
		168	`* Revision 1.54 1996/01/17 10:28:07 currie`
		169	`* param alignment + case bigval`
		170	`*`
		171	`* Revision 1.53 1996/01/12 10:10:03 currie`
		172	`* AVS - promote pars with struct result`
		173	`*`
		174	`* Revision 1.51 1996/01/08 09:36:05 currie`
		175	`* trap_on_nil + hppa change`
		176	`*`
		177	`* Revision 1.49 1995/12/15 15:32:46 currie`
		178	`* Char par + string concat`
		179	`*`
		180	`* Revision 1.48 1995/12/12 09:00:43 currie`
		181	`* Non-var out_pars`
		182	`*`
		183	`* Revision 1.47 1995/12/07 11:43:26 currie`
		184	`* Identity dyn initialisation + mod for hppa error treatments`
		185	`*`
		186	`* Revision 1.46 1995/12/04 13:48:23 currie`
		187	`* postlude with struct result`
		188	`*`
		189	`* Revision 1.45 1995/12/04 10:11:54 currie`
		190	`* power wrap`
		191	`*`
		192	`* Revision 1.44 1995/11/29 15:30:11 currie`
		193	`* computed signed nat`
		194	`*`
		195	`* Revision 1.43 1995/11/23 11:31:06 currie`
		196	`* MIN_PAR_ALIGNMENT + odd & ends`
		197	`*`
		198	`* Revision 1.42 1995/10/31 12:00:15 currie`
		199	`* frame alignments & power`
		200	`*`
		201	`* Revision 1.42 1995/10/31 12:00:15 currie`
		202	`* frame alignments & power`
		203	`*`
		204	`* Revision 1.41 1995/10/24 14:33:40 currie`
		205	`* variety not shape`
		206	`*`
		207	`* Revision 1.40 1995/10/17 12:59:33 currie`
		208	`* Power tests + case + diags`
		209	`*`
		210	`* Revision 1.39 1995/10/13 15:15:07 currie`
		211	`* case + long ints on alpha`
		212	`*`
		213	`* Revision 1.38 1995/10/12 15:52:52 currie`
		214	`* inlining bug`
		215	`*`
		216	`* Revision 1.37 1995/10/11 17:10:03 currie`
		217	`* avs errors`
		218	`*`
		219	`* Revision 1.36 1995/10/10 14:46:15 currie`
		220	`* 223 - non-ansi call`
		221	`*`
		222	`* Revision 1.35 1995/10/06 14:41:57 currie`
		223	`* Env-offset alignments + new div with ET`
		224	`*`
		225	`* Revision 1.34 1995/10/02 10:55:56 currie`
		226	`* Alpha varpars + errhandle`
		227	`*`
		228	`* Revision 1.33 1995/09/27 12:39:25 currie`
		229	`* Peters PIC code`
		230	`*`
		231	`* Revision 1.32 1995/09/25 09:17:56 currie`
		232	`* assign with mode`
		233	`*`
		234	`* Revision 1.31 1995/09/22 15:47:10 currie`
		235	`* added setoutpar; tidied some non-strict ansi`
		236	`*`
		237	`* Revision 1.30 1995/09/20 12:10:18 currie`
		238	`* 64-bit shl arg2 widened`
		239	`*`
		240	`* Revision 1.29 1995/09/19 16:06:46 currie`
		241	`* isAlpha!!`
		242	`*`
		243	`* Revision 1.28 1995/09/19 11:51:46 currie`
		244	`* Changed name of init fn +gcc static bug`
		245	`*`
		246	`* Revision 1.27 1995/09/15 13:29:03 currie`
		247	`* hppa + add_prefix + r_w_m complex`
		248	`*`
		249	`* Revision 1.26 1995/09/11 15:35:34 currie`
		250	`* caller params -ve`
		251	`*`
		252	`* Revision 1.24 1995/08/31 14:18:59 currie`
		253	`* mjg mods`
		254	`*`
		255	`* Revision 1.23 1995/08/21 09:38:35 currie`
		256	`* no_trap_on_nill_contents`
		257	`*`
		258	`* Revision 1.23 1995/08/21 09:38:35 currie`
		259	`* no_trap_on_nill_contents`
		260	`*`
		261	`* Revision 1.22 1995/08/18 09:03:28 currie`
		262	`* Float variety adjusted`
		263	`*`
		264	`* Revision 1.21 1995/08/15 08:25:31 currie`
		265	`* Shift left + trap_tag`
		266	`*`
		267	`* Revision 1.20 1995/08/09 10:33:06 currie`
		268	`* otagexp list reorganised`
		269	`*`
		270	`* Revision 1.19 1995/08/09 08:59:58 currie`
		271	`* round bug`
		272	`*`
		273	`* Revision 1.18 1995/08/02 13:18:00 currie`
		274	`* Various bugs reported`
		275	`*`
		276	`* Revision 1.17 1995/07/04 10:41:22 currie`
		277	`* round with mode shape`
		278	`*`
		279	`* Revision 1.16 1995/07/03 13:42:41 currie`
		280	`* Tail call needs fp`
		281	`*`
		282	`* Revision 1.15 1995/07/03 09:15:10 currie`
		283	`* Round again`
		284	`*`
		285	`* Revision 1.14 1995/06/30 13:47:24 currie`
		286	`* shift_left unsigned`
		287	`*`
		288	`* Revision 1.13 1995/06/29 13:49:37 currie`
		289	`* place -> plce`
		290	`*`
		291	`* Revision 1.12 1995/06/28 12:12:16 currie`
		292	`* offset subtract alignments`
		293	`*`
		294	`* Revision 1.11 1995/06/28 11:53:38 currie`
		295	`* Stack limits etc`
		296	`*`
		297	`* Revision 1.10 1995/06/26 13:04:37 currie`
		298	`* make_stack_limit, env_size etc`
		299	`*`
		300	`* Revision 1.9 1995/06/22 09:19:30 currie`
		301	`* Complex power improvement`
		302	`*`
		303	`* Revision 1.7 1995/06/15 09:00:25 currie`
		304	`* No protos in sunos!`
		305	`*`
		306	`* Revision 1.6 1995/06/15 08:42:09 currie`
		307	`* make_label + check repbtseq`
		308	`*`
		309	`* Revision 1.4 1995/06/14 08:35:36 currie`
		310	`* 64 bit int<->bits`
		311	`*`
		312	`* Revision 1.3 1995/06/08 14:49:16 currie`
		313	`* changes derived from ver 3`
		314	`*`
		315	`* Revision 1.2 1995/05/05 08:10:50 currie`
		316	`* initial_value + signtures`
		317	`*`
		318	`* Revision 1.1 1995/04/06 10:44:05 currie`
		319	`* Initial revision`
		320	`*`
		321	`***********************************************************************/`
		322
		323
		324
6	7u83	325	`/* This file defines procedures called from decoder which make up`
		326	`the internal representations of the various sorts of value.`
		327	`In most cases the construction of these is evident from the`
		328	`specification and the document describing the in-store`
		329	`representation: the function merely creates the corresponding value.`
		330	`In some cases processing is performed: it is only these which are`
		331	`commented.`
		332	`Many constructions have the shape of their arguments checked by`
		333	`check_shape. These checks are implied by the specification and are`
		334	`not commented.`
		335	`*/`
2	7u83	336
		337
		338	`#include "config.h"`
		339	`#include <ctype.h>`
		340	`#include <time.h>`
		341	`#include "common_types.h"`
		342	`#include "basicread.h"`
		343	`#include "exp.h"`
		344	`#include "expmacs.h"`
		345	`#include "main_reads.h"`
		346	`#include "tags.h"`
		347	`#include "flags.h"`
		348	`#include "me_fns.h"`
		349	`#include "installglob.h"`
		350	`#include "readglob.h"`
		351	`#include "table_fns.h"`
		352	`#include "flpttypes.h"`
		353	`#include "flpt.h"`
		354	`#include "xalloc.h"`
		355	`#include "shapemacs.h"`
		356	`#include "read_fns.h"`
		357	`#include "sortmacs.h"`
		358	`#include "machine.h"`
		359	`#include "spec.h"`
		360	`#include "check_id.h"`
		361	`#include "check.h"`
		362	`#include "szs_als.h"`
		363	`#include "messages_c.h"`
		364	`#include "natmacs.h"`
		365	`#include "f64.h"`
		366	`#include "readglob.h"`
		367	`#include "case_opt.h"`
		368	`#include "install_fns.h"`
		369	`#include "externs.h"`
		370
		371	`#ifdef NEWDIAGS`
		372	`#include "dg_fns.h"`
		373	`#include "mark_scope.h"`
		374	`#endif`
		375
6	7u83	376	`#define NOTYETDONE(x) failer(x)`
2	7u83	377
		378
		379	`#define MAX_ST_LENGTH 25`
		380
		381	`/* All variables initialised */`
		382
		383	`shape f_ptr1;`
		384	`shape f_ptr8;`
		385	`shape f_ptr16;`
		386	`shape f_ptr32;`
		387	`shape f_ptr64;`
		388	`shape f_off0_0;`
		389	`shape f_off1_1;`
		390	`shape f_off8_8;`
		391	`shape f_off8_1;`
		392	`shape f_off16_16;`
		393	`shape f_off16_8;`
		394	`shape f_off16_1;`
		395	`shape f_off32_32;`
		396	`shape f_off32_16;`
		397	`shape f_off32_8;`
		398	`shape f_off32_1;`
		399	`shape f_off64_64;`
		400	`shape f_off64_32;`
		401	`shape f_off64_16;`
		402	`shape f_off64_8;`
		403	`shape f_off64_1;`
		404	`shape f_off512_512;`
		405	`shape f_off512_64;`
		406	`shape f_off512_32;`
		407	`shape f_off512_16;`
		408	`shape f_off512_8;`
		409	`shape f_off512_1;`
		410
		411	`shape ucharsh;`
		412	`shape scharsh;`
		413	`shape uwordsh;`
		414	`shape swordsh;`
		415	`shape ulongsh;`
		416	`shape slongsh;`
		417	`shape u64sh;`
		418	`shape s64sh;`
		419	`shape shrealsh;`
		420	`shape realsh;`
		421	`shape doublesh;`
		422	`shape shcomplexsh;`
		423	`shape complexsh;`
		424	`shape complexdoublesh;`
		425
		426	`shape f_bottom;`
		427	`shape f_top;`
		428	`shape f_local_label_value;`
		429
		430	`procprops f_dummy_procprops;`
		431	`procprops f_var_callers = 1;`
		432	`procprops f_var_callees = 2;`
		433	`procprops f_untidy = 4;`
		434	`procprops f_check_stack = 8;`
		435	`procprops f_no_long_jump_dest = 16;`
		436	`procprops f_inline = 32;`
		437
		438	`static proc_props initial_value_pp;`
		439
6	7u83	440	`procprops`
		441	`f_add_procprops(procprops t, procprops e)`
2	7u83	442	`{`
6	7u83	443	`return (t \| e);`
2	7u83	444	`}`
		445
6	7u83	446
2	7u83	447	`procprops no_procprops_option = 0;`
		448
6	7u83	449	`procprops`
		450	`yes_procprops_option(procprops p)`
2	7u83	451	`{`
		452	`return p;`
		453	`}`
		454
6	7u83	455
		456	`void`
		457	`init_procprops_option(void)`
2	7u83	458	`{`
		459	`return;`
		460	`}`
		461
6	7u83	462
2	7u83	463	`error_code f_overflow = 7;`
		464	`error_code f_nil_access = 19;`
		465	`error_code f_stack_overflow = 35;`
		466
6	7u83	467	`error_code_list`
		468	`add_error_code_list(error_code_list t, error_code e, int i)`
2	7u83	469	`{`
6	7u83	470	`UNUSED(i);`
		471	`return (t \| e);`
2	7u83	472	`}`
		473
6	7u83	474
		475	`error_code_list`
		476	`new_error_code_list(int n)`
2	7u83	477	`{`
6	7u83	478	`UNUSED(n);`
2	7u83	479	`return 0;`
		480	`}`
		481
6	7u83	482
2	7u83	483	`transfer_mode f_trap_on_nil = 8;`
		484
6	7u83	485	`shape`
		486	`containedshape(int a, int s)`
2	7u83	487	`{`
6	7u83	488	`switch ((a + 7) & ~7) {`
		489	`case 8:`
		490	`case 0:`
		491	`return ((s) ? scharsh : ucharsh);`
		492	`case 16:`
		493	`return ((s) ? swordsh : uwordsh);`
		494	`case 32:`
		495	`case 24:`
		496	`return ((s) ? slongsh : ulongsh);`
		497	`case 64:`
		498	`case 40:`
		499	`case 48:`
		500	`case 56:`
		501	`return ((s) ? s64sh : u64sh);`
		502	`default:`
		503	`failer("Illegal pointer for bitfield operations");`
2	7u83	504	`return scharsh;`
		505	`}`
		506	`}`
		507
6	7u83	508
		509	`dec *`
		510	`make_extra_dec(char *nme, int v, int g, exp init, shape s)`
2	7u83	511	`{`
6	7u83	512	`dec extra_dec = (dec )calloc(1, sizeof(dec));`
		513	`exp e = getexp(s, nilexp, 0, init, nilexp, 0, 0, ident_tag);`
		514	`setglob(e);`
		515	`if (v) {`
		516	`setvar(e);`
		517	`}`
		518	`brog(e) = extra_dec;`
		519	`extra_dec->def_next = (dec *)0;`
		520	`*deflist_end = extra_dec;`
		521	`deflist_end = &((*deflist_end)->def_next);`
		522	`extra_dec->dec_u.dec_val.dec_id = nme;`
		523	`extra_dec->dec_u.dec_val.dec_shape = s;`
		524	`extra_dec->dec_u.dec_val.dec_exp = e;`
		525	`extra_dec->dec_u.dec_val.unit_number = crt_tagdef_unit_no;`
		526	`extra_dec->dec_u.dec_val.diag_info = (diag_global *)0;`
		527	`extra_dec->dec_u.dec_val.extnamed = (unsigned int)g;`
		528	`extra_dec->dec_u.dec_val.dec_var = (unsigned int)v;`
		529	`extra_dec->dec_u.dec_val.dec_outermost = 0;`
		530	`extra_dec->dec_u.dec_val.have_def = init != nilexp;`
		531	`extra_dec->dec_u.dec_val.processed = 0;`
		532	`extra_dec->dec_u.dec_val.isweak = 0;`
		533	`extra_dec->dec_u.dec_val.is_common = 0;`
		534	`if (init != nilexp) {`
		535	`setfather(e, init);`
		536	`}`
		537	`return extra_dec;`
2	7u83	538	`}`
		539
6	7u83	540
		541	`dec *`
		542	`find_named_dec(char *n)`
2	7u83	543	`{`
6	7u83	544	`/* find a global with name n */`
		545	`dec *my_def = top_def;`
2	7u83	546
6	7u83	547	`while (my_def != (dec *)0) {`
		548	`char *id = my_def->dec_u.dec_val.dec_id;`
		549	`if (strcmp(id + strlen(name_prefix), n) == 0) {`
		550	`return my_def;`
		551	`}`
		552	`my_def = my_def->def_next;`
		553	`}`
		554	`return (dec *)0;`
2	7u83	555	`}`
		556
6	7u83	557
		558	`exp`
		559	`find_named_tg(char *n, shape s)`
2	7u83	560	`{`
6	7u83	561	`/* find a global with name n */`
		562	`dec *my_def = find_named_dec(n);`
		563	`if (my_def != (dec*)0) {`
		564	`return my_def->dec_u.dec_val.dec_exp;`
		565	`}`
		566	`my_def = make_extra_dec(add_prefix(n), 0, 1, nilexp, s);`
		567	`return my_def->dec_u.dec_val.dec_exp;`
2	7u83	568	`}`
		569
		570
		571	`#if !has64bits`
6	7u83	572	`char *`
		573	`fn_of_op(int nm, int sngd)`
2	7u83	574	`{`
		575	`/* Find a run-time library fn corresponding to nm */`
		576
6	7u83	577	`#define CSU(x, y) return (sngd) ? x : y`
2	7u83	578	`switch (nm) {`
6	7u83	579	`case plus_tag:`
		580	`CSU("__TDFUs_plus", "__TDFUu_plus");`
		581	`case minus_tag:`
		582	`CSU("__TDFUs_minus", "__TDFUu_minus");`
		583	`case mult_tag:`
		584	`CSU("__TDFUs_mult", "__TDFUu_mult");`
		585	`case div0_tag:`
		586	`case div2_tag:`
		587	`CSU("__TDFUs_div2", "__TDFUu_div2");`
		588	`case div1_tag:`
		589	`CSU("__TDFUs_div1", "__TDFUu_div2");`
		590	`case rem0_tag:`
		591	`case rem2_tag:`
		592	`CSU("__TDFUs_rem2", "__TDFUu_rem2");`
		593	`case mod_tag:`
		594	`CSU("__TDFUs_rem1", "__TDFUu_rem2");`
		595	`case shl_tag:`
		596	`CSU("__TDFUs_shl", "__TDFUu_shl");`
		597	`case shr_tag:`
		598	`CSU("__TDFUs_shr", "__TDFUu_shr");`
		599	`case neg_tag:`
		600	`return "__TDFUneg";`
		601	`case abs_tag:`
		602	`return "__TDFUabs";`
		603	`case chvar_tag:`
		604	`CSU("__TDFUs_chvar", "__TDFUu_chvar");`
		605	`case max_tag:`
		606	`CSU("__TDFUs_max", "__TDFUu_max");`
		607	`case min_tag:`
		608	`CSU("__TDFUs_min", "__TDFUu_min");`
		609	`case test_tag:`
		610	`CSU("__TDFUs_test", "__TDFUu_test");`
		611	`case float_tag:`
		612	`CSU("__TDFUs_float", "__TDFUu_float");`
		613	`case and_tag:`
		614	`return "__TDFUand";`
		615	`case or_tag:`
		616	`return "__TDFUor";`
		617	`case xor_tag:`
		618	`return "__TDFUxor";`
		619	`case not_tag:`
		620	`return "__TDFUnot";`
		621	`default:`
		622	`failer("No fn for long op");`
2	7u83	623	`}`
		624	`return "__TDFerror";`
		625	`}`
		626
6	7u83	627
		628	`exp`
		629	`TDFcallop3(exp arg1, exp arg2, int n)`
2	7u83	630	`{`
		631	`/* construct proc call for binary op corresponding to n */`
6	7u83	632	`char *nm = fn_of_op(n, is_signed(sh(arg1)));`
2	7u83	633	`exp dc;`
		634	`exp ob;`
		635	`exp_list pars;`
		636	`exp_option novar;`
		637	`exp res;`
		638	`novar.present = 0;`
		639	`dc = find_named_tg(nm, f_proc);`
		640	`ob = me_obtain(dc);`
		641	`pars.number = 2;`
		642	`pars.start = arg1;`
		643	`pars.end = arg2;`
6	7u83	644	`bro(arg1) = arg2;`
		645	`clearlast(arg1);`
2	7u83	646
		647	`res = f_apply_proc(sh(arg1), ob, pars, novar);`
		648	`res = hold_check(res);`
		649	`return res;`
		650	`}`
		651
6	7u83	652
		653	`exp`
		654	`TDFwithet(error_treatment ov_err, exp e)`
2	7u83	655	`{`
		656	`exp id;`
		657	`exp c;`
		658	`exp_list el;`
		659	`exp Te;`
6	7u83	660	`if (ov_err.err_code <= 2) {`
		661	`return e;`
		662	`}`
		663	`Te = find_named_tg("__TDFerror", slongsh);`
		664	`brog(Te)->dec_u.dec_val.dec_var = 1;`
2	7u83	665	`#if keep_PIC_vars`
6	7u83	666	`setvar(Te);`
2	7u83	667	`#else`
6	7u83	668	`if (PIC_code) {`
		669	`sh(Te) = f_pointer(f_alignment(slongsh));`
		670	`} else {`
		671	`setvar(Te);`
		672	`}`
2	7u83	673	`#endif`
		674	`id = me_startid(sh(e), e, 0);`
		675	`c = f_contents(slongsh, me_obtain(Te));`
		676	`el = new_exp_list(1);`
6	7u83	677	`el = add_exp_list(el, f_plus(ov_err, me_shint(slongsh, (int)0x80000000),`
		678	`c), 0);`
2	7u83	679	`return me_complete_id(id, f_sequence(el, me_obtain(id)));`
		680	`}`
		681
		682
6	7u83	683	`exp`
		684	`TDFcallop2(error_treatment ov_err, exp arg1, exp arg2, int n)`
2	7u83	685	`{`
		686	`/* construct proc call for binary op corresponding to n */`
		687	`/* ignore error treatment for the moment */`
6	7u83	688	`char *nm = fn_of_op(n, is_signed(sh(arg1)));`
2	7u83	689	`exp dc;`
		690	`exp ob;`
		691	`exp_list pars;`
		692	`exp_option novar;`
		693	`exp res;`
		694	`novar.present = 0;`
		695	`dc = find_named_tg(nm, f_proc);`
		696	`ob = me_obtain(dc);`
		697	`pars.number = 2;`
		698	`pars.start = arg1;`
		699	`pars.end = arg2;`
6	7u83	700	`bro(arg1) = arg2;`
		701	`clearlast(arg1);`
2	7u83	702
		703	`res = f_apply_proc((n==test_tag)?slongsh:sh(arg1), ob, pars, novar);`
		704
6	7u83	705	`return TDFwithet(ov_err, res);`
2	7u83	706	`}`
		707
		708
6	7u83	709	`exp`
		710	`TDFcallaux(error_treatment ov_err, exp arg1, char *nm, shape s)`
2	7u83	711	`{`
		712	`exp dc;`
		713	`exp ob;`
		714	`exp_list pars;`
		715	`exp_option novar;`
		716	`exp res;`
		717	`novar.present = 0;`
		718	`dc = find_named_tg(nm, f_proc);`
		719	`ob = me_obtain(dc);`
		720	`pars.number = 1;`
		721	`pars.start = arg1;`
		722	`pars.end = arg1;`
		723
		724	`res = f_apply_proc(s, ob, pars, novar);`
		725	`res = hold_check(res);`
6	7u83	726	`return TDFwithet(ov_err, res);`
2	7u83	727	`}`
		728
		729
		730	`exp TDFcallop1`
6	7u83	731	`(error_treatment ov_err, exp arg1, int n)`
2	7u83	732	`{`
		733	`/* construct proc call for unary op corresponding to n */`
		734	`/* ignore error treatment for the moment */`
6	7u83	735	`char *nm = fn_of_op(n, is_signed(sh(arg1)));`
		736	`return TDFcallaux(ov_err, arg1, nm, sh(arg1));`
2	7u83	737	`}`
		738
6	7u83	739
		740	`exp`
		741	`TDFcallop4(exp arg1, int n)`
2	7u83	742	`{`
		743	`/* construct proc call for unary op corresponding to n */`
		744
6	7u83	745	`char *nm = fn_of_op(n, is_signed(sh(arg1)));`
2	7u83	746	`exp dc;`
		747	`exp ob;`
		748	`exp_list pars;`
		749	`exp_option novar;`
		750	`exp res;`
		751	`novar.present = 0;`
		752	`dc = find_named_tg(nm, f_proc);`
		753	`ob = me_obtain(dc);`
		754	`pars.number = 1;`
		755	`pars.start = arg1;`
		756	`pars.end = arg1;`
		757
		758	`res = f_apply_proc(sh(arg1), ob, pars, novar);`
		759
		760	`return res;`
		761	`}`
6	7u83	762	`#endif /* !has64bits */`
2	7u83	763
		764
		765	`error_treatment f_wrap;`
		766	`error_treatment f_impossible;`
		767	`error_treatment f_continue;`
		768
		769
		770	`#ifdef promote_pars`
6	7u83	771	`static void`
		772	`promote_actuals(exp par)`
2	7u83	773	`{`
6	7u83	774	`for (;;) {`
		775	`shape s = sh(par);`
		776	`if (name(s) >= scharhd && name(s) <= uwordhd) {`
		777	`shape ns = (is_signed(s)) ? slongsh : ulongsh;`
		778	`exp w = hold_check(f_change_variety(f_wrap, ns,`
		779	`copy(par)));`
		780	`replace(par, w, nilexp);`
		781	`kill_exp(par, nilexp);`
		782	`par = w;`
		783	`}`
		784	`if (last(par)) {`
		785	`break;`
		786	`}`
		787	`par = bro(par);`
2	7u83	788	`}`
		789	`}`
		790
6	7u83	791
		792	`static void`
		793	`promote_formals(exp bdy)`
2	7u83	794	`{`
		795	`while ((name(bdy) == ident_tag && isparam(bdy))`
		796	`#ifndef NEWDIAGS`
6	7u83	797	`\|\| name(bdy) == diagnose_tag`
2	7u83	798	`#endif`
6	7u83	799	`) {`
		800	`shape spar = sh(son(bdy));`
		801	`if (name(bdy) != ident_tag) {`
		802	`bdy = son(bdy);`
		803	`continue;`
2	7u83	804	`}`
6	7u83	805	`if (name(spar) >= scharhd && name(spar) <= uwordhd) {`
		806	`shape ns = (is_signed(spar)) ? slongsh : ulongsh;`
		807	`exp u = pt(bdy);`
		808	`exp w;`
		809	`sh(son(bdy)) = ns;`
		810	`if (!isvar(bdy)) {`
		811	`while (u != nilexp) {`
		812	`exp nextu = pt(u);`
		813	`sh(u) = ns;`
		814	`w = f_change_variety(f_wrap, spar,`
		815	`copy(u));`
		816	`replace(u, w, nilexp);`
		817	`kill_exp(u, nilexp);`
		818	`u = nextu;`
2	7u83	819	`}`
6	7u83	820	`} else {`
		821	`shape ps = f_pointer(f_alignment(ns));`
		822	`while (u != nilexp) {`
		823	`exp nextu = pt(u);`
		824	`if (last(u) && name(bro(u)) == cont_tag) {`
		825	`if (little_end) {`
		826	`exp con = bro(u);`
		827	`sh(u) = ps;`
		828	`sh(con) = ns;`
		829	`w = f_change_variety(`
		830	`f_wrap, spar,`
		831	`copy(con));`
		832	`replace(con, w, nilexp);`
		833	`kill_exp(con, nilexp);`
		834	`}`
		835	`} else {`
		836	`setvis(bdy);`
		837	`if (!little_end) {`
		838	`sh(u) = ps;`
		839	`no(u) = shape_size(ns) -`
		840	`shape_size(spar);`
		841	`}`
		842	`}`
		843	`u = nextu;`
		844	`}`
2	7u83	845	`}`
		846	`}`
6	7u83	847	`bdy = bro(son(bdy));`
2	7u83	848	`}`
		849	`}`
6	7u83	850	`#endif /* promote_pars */`
2	7u83	851
		852
		853	`aldef frame_als[32];`
		854
		855	`alignment f_locals_alignment = &frame_als[0];`
		856	`alignment nv_callers_alignment = &frame_als[1];`
		857	`alignment var_callers_alignment = &frame_als[3];`
		858	`alignment nv_callees_alignment = &frame_als[7];`
		859	`alignment var_callees_alignment = &frame_als[15];`
		860
6	7u83	861	`void`
		862	`init_frame_als(void)`
2	7u83	863	`{`
6	7u83	864	`int i;`
		865	`for (i = 0; i < 32; i++) {`
		866	`frame_als[i].al.sh_hd = 0;`
		867	`frame_als[i].al.al_n = 1;`
		868	`frame_als[i].al.al_val.al = 64;`
		869	`frame_als[i].al.al_val.al_frame = i + 1;`
		870	`}`
2	7u83	871	`}`
		872
6	7u83	873
		874	`error_treatment`
		875	`f_trap(error_code_list ec)`
2	7u83	876	`{`
6	7u83	877	`error_treatment res;`
		878	`res.err_code = ec;`
		879	`return res;`
2	7u83	880	`}`
		881
6	7u83	882
		883	`alignment`
		884	`f_callers_alignment(bool var)`
2	7u83	885	`{`
6	7u83	886	`return ((var) ? var_callers_alignment : nv_callers_alignment);`
2	7u83	887	`}`
		888
6	7u83	889
		890	`alignment`
		891	`f_callees_alignment(bool var)`
2	7u83	892	`{`
6	7u83	893	`return ((var) ? var_callees_alignment : nv_callees_alignment);`
2	7u83	894	`}`
		895
		896
6	7u83	897	`otagexp`
		898	`f_make_otagexp(tag_option tagopt, exp e)`
2	7u83	899	`{`
		900	`exp init;`
6	7u83	901	`if (!tagopt.present) {`
		902	`return e;`
		903	`}`
2	7u83	904	`e = getexp(sh(e), nilexp, 0, e, nilexp, 0, 0, caller_tag);`
		905	`init = getexp(sh(e), nilexp, 0, nilexp , nilexp, 0, 0, caller_name_tag);`
		906	`pt(e) = getexp(f_top, nilexp, 0, init, nilexp, 0, 0, ident_tag);`
6	7u83	907	`/* setvar(pt(e)); - NOT ACCORDING TO SPEC */`
		908	`setfather(e, son(e));`
2	7u83	909	`set_tag(tagopt.val, pt(e));`
		910	`return e;`
		911	`}`
		912
6	7u83	913
		914	`otagexp_list`
		915	`new_otagexp_list(int n)`
2	7u83	916	`{`
		917	`otagexp_list res;`
		918	`res.number =0;`
		919	`res.start = nilexp;`
		920	`res.end = nilexp;`
		921	`res.id = nilexp;`
6	7u83	922	`UNUSED(n);`
2	7u83	923	`return res;`
		924	`}`
		925
6	7u83	926
		927	`otagexp_list`
		928	`add_otagexp_list(otagexp_list list, otagexp ote, int n)`
2	7u83	929	`{`
		930	`if (list.number++ == 0) {`
6	7u83	931	`list.start = list.end = ote;`
		932	`} else {`
2	7u83	933	`bro(list.end) = ote;`
		934	`clearlast(list.end);`
		935	`list.end = ote;`
		936	`}`
		937	`setlast(ote);`
6	7u83	938	`if (name(ote) == caller_tag) {`
2	7u83	939	`exp id = pt(ote);`
		940	`exp lid = list.id;`
		941	`bro(son(id)) = lid;`
		942	`if (lid != nilexp) {`
6	7u83	943	`bro(lid) = id;`
		944	`setlast(lid);`
2	7u83	945	`}`
		946	`no(son(id)) = n;`
		947	`list.id = id;`
		948	`pt(ote) = nilexp; /* this pt is a temp link */`
		949	`}`
		950	`return list;`
		951	`}`
		952
6	7u83	953
		954	`callees`
		955	`f_make_callee_list(exp_list args)`
2	7u83	956	`{`
6	7u83	957	`exp e = getexp(f_top, nilexp, 0, args.start, nilexp, 0, args.number,`
		958	`make_callee_list_tag);`
		959	`if (args.number != 0) {`
		960	`setfather(e, args.end);`
2	7u83	961	`#ifdef promote_pars`
		962	`promote_actuals(args.start);`
		963	`#endif`
6	7u83	964	`}`
2	7u83	965	`return e;`
		966	`}`
		967
6	7u83	968
		969	`callees`
		970	`f_make_dynamic_callees(exp ptr, exp sze)`
2	7u83	971	`{`
		972	`exp e = getexp(f_top, nilexp, 0, ptr, nilexp, 0, 0,`
6	7u83	973	`make_dynamic_callee_tag);`
		974	`bro(ptr) = sze;`
		975	`clearlast(ptr);`
2	7u83	976	`setfather(e, sze);`
		977	`return e;`
		978	`}`
		979
		980
6	7u83	981	`/* exps waiting to be used have the parked flag set in props,`
		982	`so that used_in need not look at their context.`
		983	`This procedure removes the parked flag from each member of an`
		984	`exp list, in preparation for putting them into their`
		985	`proper context.`
		986	`*/`
		987	`void`
		988	`clear_exp_list(exp_list el)`
2	7u83	989	`{`
6	7u83	990	`exp t = el.start;`
		991	`if (t == nilexp) {`
		992	`return;`
		993	`}`
		994	`while (1) {`
		995	`parked(t) = 0;`
		996	`if (t == el.end) {`
		997	`return;`
		998	`}`
		999	`t = bro(t);`
		1000	`}`
2	7u83	1001	`}`
		1002
		1003
		1004	`alignment frame_alignment;`
		1005
6	7u83	1006	`/* ntest codes */`
2	7u83	1007	`ntest f_equal = 5;`
		1008	`ntest f_greater_than = 1;`
		1009	`ntest f_greater_than_or_equal = 2;`
		1010	`ntest f_less_than = 3;`
		1011	`ntest f_less_than_or_equal = 4;`
		1012	`ntest f_not_equal = 6;`
		1013	`ntest f_not_greater_than = 10;`
		1014	`ntest f_not_greater_than_or_equal = 9;`
		1015	`ntest f_not_less_than = 8;`
		1016	`ntest f_not_less_than_or_equal = 7;`
		1017
		1018	`ntest f_less_than_or_greater_than = 11;`
		1019	`ntest f_not_less_than_and_not_greater_than = 12;`
		1020	`ntest f_comparable = 13;`
		1021	`ntest f_not_comparable = 14;`
		1022
		1023	`static ntest convert_ntest[] = {0, 1, 2, 3, 4, 5, 6,`
		1024	`1, 2, 3, 4, 6, 5, 13, 14};`
		1025
6	7u83	1026	`static exp`
		1027	`replace_ntest(ntest nt, label dest, exp arg1, exp arg2)`
2	7u83	1028	`{`
6	7u83	1029	`exp res;`
		1030	`exp_list el;`
		1031	`el = new_exp_list(2);`
		1032	`el = add_exp_list(el, arg1, 0);`
		1033	`el = add_exp_list(el, arg2, 1);`
2	7u83	1034
6	7u83	1035	`if (nt == f_comparable) {`
		1036	`res = f_make_top();`
		1037	`} else {`
		1038	`res = f_goto(dest);`
		1039	`}`
2	7u83	1040
6	7u83	1041	`return f_sequence(el, res);`
2	7u83	1042	`}`
		1043
		1044
6	7u83	1045	`/* rounding mode codes */`
2	7u83	1046	`rounding_mode f_to_nearest = R2NEAR;`
		1047	`rounding_mode f_toward_larger = R2PINF;`
		1048	`rounding_mode f_toward_smaller = R2NINF;`
		1049	`rounding_mode f_toward_zero = R2ZERO;`
		1050	`rounding_mode f_round_as_state = 4;`
		1051
		1052	`transfer_mode f_standard_transfer_mode = 0;`
		1053	`transfer_mode f_volatile = 1;`
		1054	`transfer_mode f_overlap = 2;`
		1055	`transfer_mode f_complete = 4;`
		1056
6	7u83	1057	`#define max(x, y) ((x) > (y)) ? (x) : (y)`
		1058	`/* careful: use simple arguments! */`
2	7u83	1059
6	7u83	1060	`alignment`
		1061	`f_alignment(shape sha)`
2	7u83	1062	`{`
6	7u83	1063	`return align_of(sha);`
2	7u83	1064	`}`
		1065
6	7u83	1066
2	7u83	1067	`/* we may not yet know the actual values for the alignments,`
		1068	`merely that they are computed from other alignments by unite.`
		1069	`So we have to set up equations which are solved at the end of aldefs`
		1070	`*/`
6	7u83	1071	`alignment`
		1072	`f_obtain_al_tag(al_tag a1)`
2	7u83	1073	`{`
6	7u83	1074	`alignment j;`
		1075	`if (a1->al.al_n == 1) {`
		1076	`return long_to_al(a1->al.al_val.al);`
		1077	`}`
		1078	`j = (alignment)calloc(1, sizeof(aldef));`
		1079	`j->al.al_n = 3;`
		1080	`j->al.al_val.al_join.a = a1;`
		1081	`j->next_aldef = top_aldef;`
		1082	`top_aldef = j;`
		1083	`return j;`
2	7u83	1084	`}`
		1085
6	7u83	1086
		1087	`alignment`
		1088	`f_unite_alignments(alignment a1, alignment a2)`
2	7u83	1089	`{`
6	7u83	1090	`alignment j;`
		1091	`if (a1->al.al_n == 1 && a2->al.al_n == 1) {`
		1092	`if (a1->al.al_val.al_frame == a2->al.al_val.al_frame) {`
		1093	`if (a1->al.al_val.al > a2->al.al_val.al) {`
		1094	`return a1;`
		1095	`} else {`
		1096	`return a2;`
		1097	`}`
		1098	`} else if (a1->al.al_val.al_frame ==0) {`
		1099	`return a2;`
		1100	`} else if (a2->al.al_val.al_frame == 0) {`
		1101	`return a1;`
		1102	`} else {`
		1103	`return (&frame_als[(a1->al.al_val.al_frame \|`
		1104	`a2->al.al_val.al_frame) -1]);`
		1105	`}`
		1106	`}`
2	7u83	1107
6	7u83	1108	`j = (alignment)calloc(1, sizeof(aldef));`
		1109	`j->al.al_n = 2;`
		1110	`j->al.al_val.al_join.a = a1;`
		1111	`j->al.al_val.al_join.b = a2;`
		1112	`j->next_aldef = top_aldef;`
		1113	`top_aldef = j;`
		1114	`return j;`
2	7u83	1115	`}`
		1116
		1117
6	7u83	1118	`void`
		1119	`init_access(void)`
2	7u83	1120	`{`
6	7u83	1121	`return;`
2	7u83	1122	`}`
		1123
6	7u83	1124
2	7u83	1125	`access f_dummy_access;`
		1126
		1127	`access f_visible = 1;`
		1128	`access f_standard_access = 0;`
		1129	`access f_long_jump_access = 2;`
		1130	`access f_constant = 4;`
		1131	`access f_no_other_read = 8;`
		1132	`access f_no_other_write = 16;`
		1133	`access f_register = 32;`
		1134	`access f_out_par = 64;`
		1135	`access f_used_as_volatile = 128;`
		1136	`access f_preserve = 256;`
		1137
6	7u83	1138	`access`
		1139	`f_add_accesses(access a1, access a2)`
2	7u83	1140	`{`
6	7u83	1141	`return a1 \| a2;`
2	7u83	1142	`}`
		1143
		1144
		1145	`alignment f_alloca_alignment;`
		1146	`alignment f_var_param_alignment;`
		1147	`alignment f_code_alignment;`
		1148
6	7u83	1149	`static struct CAL {`
		1150	`short sh_hd;`
		1151	`short al;`
		1152	`alignment res;`
		1153	`struct CAL *rest;`
		1154	`} *cache_pals;`
2	7u83	1155
6	7u83	1156	`void`
		1157	`init_alignment(void)`
2	7u83	1158	`{`
6	7u83	1159	`const_al1->al.al_n = 1;`
		1160	`const_al1->al.al_val.al = 1;`
		1161	`const_al1->al.al_val.al_frame = 0;`
		1162	`const_al1->al.sh_hd = 0;`
		1163	`const_al8->al.al_n = 1;`
		1164	`const_al8->al.al_val.al = 8;`
		1165	`const_al8->al.al_val.al_frame = 0;`
		1166	`const_al8->al.sh_hd = 0;`
		1167	`const_al16->al.al_n = 1;`
		1168	`const_al16->al.al_val.al = 16;`
		1169	`const_al16->al.al_val.al_frame = 0;`
		1170	`const_al16->al.sh_hd = 0;`
		1171	`const_al32->al.al_n = 1;`
		1172	`const_al32->al.al_val.al = 32;`
		1173	`const_al32->al.al_val.al_frame = 0;`
		1174	`const_al32->al.sh_hd = 0;`
		1175	`const_al64->al.al_n = 1;`
		1176	`const_al64->al.al_val.al = 64;`
		1177	`const_al64->al.al_val.al_frame = 0;`
		1178	`const_al64->al.sh_hd = 0;`
		1179	`const_al512->al.al_n = 1;`
		1180	`const_al512->al.al_val.al = 512;`
		1181	`const_al512->al.al_val.al_frame = 0;`
		1182	`const_al512->al.sh_hd = 0;`
2	7u83	1183
6	7u83	1184	`cache_pals = (struct CAL *)0;`
2	7u83	1185
6	7u83	1186	`init_frame_als();`
		1187	`f_alloca_alignment = ALLOCA_ALIGN;`
		1188	`f_var_param_alignment = VAR_PARAM_ALIGN;`
		1189	`f_code_alignment = CODE_ALIGN;`
		1190	`stack_align = max(param_align, double_align);`
		1191	`return;`
2	7u83	1192	`}`
		1193
6	7u83	1194
2	7u83	1195	`alignment f_dummy_alignment;`
		1196
6	7u83	1197	`static alignment`
		1198	`get_pal(alignment a, int sh_hd, int al)`
2	7u83	1199	`{`
6	7u83	1200	`struct CAL *c = cache_pals;`
2	7u83	1201	`alignment res;`
6	7u83	1202	`while (c != (struct CAL *)0) {`
		1203	`if (c->sh_hd == sh_hd && c->al == al) {`
		1204	`return c->res;`
		1205	`}`
2	7u83	1206	`c = c->rest;`
		1207	`}`
		1208	`res = (alignment)xmalloc(sizeof(aldef));`
		1209	`res = a;`
6	7u83	1210	`res->al.sh_hd = sh_hd;`
		1211	`c = (struct CAL *)xmalloc(sizeof(struct CAL));`
		1212	`c->sh_hd = sh_hd;`
		1213	`c->al = al;`
		1214	`c->res = res;`
		1215	`c->rest = cache_pals;`
2	7u83	1216	`cache_pals = c;`
		1217	`return res;`
		1218	`}`
		1219
6	7u83	1220
		1221	`alignment`
		1222	`f_parameter_alignment(shape sha)`
2	7u83	1223	`{`
		1224	`int n = name(sha);`
		1225	`alignment t =`
		1226	`#if issparc`
6	7u83	1227	`MIN_PAR_ALIGNMENT;`
2	7u83	1228	`#else`
6	7u83	1229	`f_unite_alignments(MIN_PAR_ALIGNMENT, f_alignment(sha));`
2	7u83	1230	`#endif`
		1231	`#if ishppa`
6	7u83	1232	`if (shape_size(sha) > 64) {`
		1233	`n = nofhd + 1;`
		1234	`}`
2	7u83	1235	`#endif`
		1236	`#if issparc`
6	7u83	1237	`if (sparccpd(sha)) {`
		1238	`n = nofhd + 1;`
		1239	`}`
2	7u83	1240	`#endif`
		1241
6	7u83	1242	`return get_pal(t, n, shape_align(sha));`
2	7u83	1243	`}`
		1244
6	7u83	1245
		1246	`bitfield_variety`
		1247	`f_bfvar_bits(bool issigned, nat bits)`
2	7u83	1248	`{`
6	7u83	1249	`bitfield_variety res;`
		1250	`if (!nat_issmall(bits)) {`
		1251	`failer(TOO_MANY_BITS);`
		1252	`}`
		1253	`res.has_sign = issigned;`
		1254	`res.bits = natint(bits);`
		1255	`if (extra_checks && res.bits > SLONG_SZ) {`
		1256	`failer(TOO_MANY_BITS);`
		1257	`}`
		1258	`return res;`
2	7u83	1259	`}`
		1260
6	7u83	1261
		1262	`void`
		1263	`init_bitfield_variety(void)`
2	7u83	1264	`{`
6	7u83	1265	`return;`
2	7u83	1266	`}`
		1267
6	7u83	1268
2	7u83	1269	`bitfield_variety f_dummy_bitfield_variety;`
		1270
		1271	`bool f_false = 0;`
		1272	`bool f_true = 1;`
		1273
6	7u83	1274	`void`
		1275	`init_bool(void)`
2	7u83	1276	`{`
6	7u83	1277	`return;`
2	7u83	1278	`}`
		1279
6	7u83	1280
2	7u83	1281	`bool f_dummy_bool;`
		1282
6	7u83	1283	`caselim`
		1284	`f_make_caselim(label branch, signed_nat lower, signed_nat upper)`
2	7u83	1285	`{`
6	7u83	1286	`caselim c;`
		1287	`c.lab = branch;`
		1288	`c.low = lower;`
		1289	`c.high = upper;`
		1290	`return c;`
2	7u83	1291	`}`
		1292
6	7u83	1293
2	7u83	1294	`callees f_dummy_callees;`
		1295
		1296	`callees f_same_callees;`
		1297
6	7u83	1298	`void`
		1299	`init_callees(void)`
2	7u83	1300	`{`
		1301	`f_same_callees = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0,`
6	7u83	1302	`same_callees_tag);`
2	7u83	1303	`return;`
		1304	`}`
		1305
6	7u83	1306
		1307	`void`
		1308	`init_caselim(void)`
2	7u83	1309	`{`
6	7u83	1310	`return;`
2	7u83	1311	`}`
		1312
6	7u83	1313
		1314	`error_treatment`
		1315	`f_error_jump(label lab)`
2	7u83	1316	`{`
6	7u83	1317	`error_treatment e;`
		1318	`e.err_code = 4;`
		1319	`e.jmp_dest = lab;`
		1320	`return e;`
2	7u83	1321	`}`
		1322
		1323
		1324	`error_code f_dummy_error_code;`
		1325
6	7u83	1326	`void`
		1327	`init_error_code(void)`
2	7u83	1328	`{`
		1329	`return;`
		1330	`}`
		1331
6	7u83	1332
		1333	`void`
		1334	`init_error_treatment(void)`
2	7u83	1335	`{`
6	7u83	1336	`f_wrap.err_code = 1;`
		1337	`f_impossible.err_code = 0;`
		1338	`f_continue.err_code = 2;`
		1339	`return;`
2	7u83	1340	`}`
		1341
6	7u83	1342
2	7u83	1343	`error_treatment f_dummy_error_treatment;`
		1344
6	7u83	1345	`exp`
		1346	`f_abs(error_treatment ov_err, exp arg1)`
2	7u83	1347	`{`
6	7u83	1348	`if (name(sh(arg1)) == bothd \|\| !is_signed(sh(arg1))) {`
		1349	`return arg1;`
		1350	`}`
2	7u83	1351
		1352	`#if check_shape`
6	7u83	1353	`if (!is_integer(sh(arg1))) {`
		1354	`failer(CHSH_ABS);`
		1355	`}`
2	7u83	1356	`#endif`
		1357	`#if !has64bits`
		1358	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	1359	`(name(arg1) != val_tag \|\| ov_err.err_code > 2)) {`
		1360	`return TDFcallop1(ov_err, arg1, abs_tag);`
2	7u83	1361	`}`
		1362	`#endif`
		1363
6	7u83	1364	`return me_u1(ov_err, arg1, abs_tag);`
2	7u83	1365	`}`
		1366
6	7u83	1367
		1368	`exp`
		1369	`f_add_to_ptr(exp arg1, exp arg2)`
2	7u83	1370	`{`
6	7u83	1371	`if (name(sh(arg1)) == bothd) {`
		1372	`kill_exp(arg2, arg2);`
		1373	`return arg1;`
		1374	`}`
		1375	`if (name(sh(arg2)) == bothd) {`
		1376	`kill_exp(arg1, arg1);`
		1377	`return arg2;`
		1378	`}`
2	7u83	1379
		1380	`#if check_shape`
6	7u83	1381	`if (!doing_aldefs && (name(sh(arg1)) != ptrhd \|\|`
		1382	`name(sh(arg2)) != offsethd \|\|`
		1383	`(al1(sh(arg1)) < al1(sh(arg2))`
2	7u83	1384	`#if issparc`
6	7u83	1385	`&& al1_of(sh(arg2)) != REAL_ALIGN`
2	7u83	1386	`#endif`
6	7u83	1387	`))) {`
		1388	`failer(CHSH_ADDPTR);`
		1389	`}`
2	7u83	1390	`#endif`
		1391
		1392	`#if issparc \|\| ishppa`
6	7u83	1393	`if ((al1_of(sh(arg2))->al.al_val.al_frame & 6) != 0 &&`
2	7u83	1394	`#else`
6	7u83	1395	`if ((al1_of(sh(arg2))->al.al_val.al_frame & 4) != 0 &&`
2	7u83	1396	`#endif`
6	7u83	1397	`al2_of(sh(arg2))->al.sh_hd > nofhd) {`
		1398	`/* indirect varargs param */`
		1399	`exp z = me_b3(f_pointer(f_alignment(sh(arg1))), arg1, arg2,`
		1400	`addptr_tag);`
		1401	`return f_contents(sh(arg1), z);`
		1402	`}`
		1403
		1404	`return (me_b3(f_pointer(al2_of(sh(arg2))), arg1, arg2, addptr_tag));`
2	7u83	1405	`}`
		1406
		1407
6	7u83	1408	`exp`
		1409	`f_and(exp arg1, exp arg2)`
2	7u83	1410	`{`
6	7u83	1411	`if (name(sh(arg1)) == bothd) {`
		1412	`kill_exp(arg2, arg2);`
		1413	`return arg1;`
		1414	`}`
		1415	`if (name(sh(arg2)) == bothd) {`
		1416	`kill_exp(arg1, arg1);`
		1417	`return arg2;`
		1418	`}`
2	7u83	1419
		1420	`#if check_shape`
6	7u83	1421	`if (!eq_shape(sh(arg1), sh(arg2)) \|\| !is_integer(sh(arg1))) {`
		1422	`failer(CHSH_AND);`
		1423	`}`
2	7u83	1424	`#endif`
		1425	`#if !has64bits`
		1426	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	1427	`(name(arg1) != val_tag \|\| name(arg2) != val_tag)) {`
		1428	`return TDFcallop3(arg1, arg2, and_tag);`
2	7u83	1429	`}`
		1430	`#endif`
		1431
6	7u83	1432	`return me_b2(arg1, arg2, and_tag);`
2	7u83	1433	`}`
		1434
6	7u83	1435
		1436	`exp`
		1437	`f_apply_proc(shape result_shape, exp arg1, exp_list arg2, exp_option varparam)`
2	7u83	1438	`{`
6	7u83	1439	`exp res = getexp(result_shape, nilexp, 0, arg1, nilexp, 0, 0,`
		1440	`apply_tag);`
		1441	`int varhack = 0;`
		1442	`if (name(sh(arg1)) == bothd) {`
		1443	`return arg1;`
		1444	`}`
2	7u83	1445
		1446	`#if check_shape`
6	7u83	1447	`if (name(sh(arg1)) != prokhd) {`
		1448	`failer(CHSH_APPLY);`
		1449	`}`
2	7u83	1450	`#endif`
		1451
6	7u83	1452	`if (varparam.present) {`
		1453	`/* add a declaration for variable parameters */`
		1454	`arg2 = add_exp_list(arg2, varparam.val, arg2.number + 1);`
		1455	`varhack =1;`
		1456	`}`
2	7u83	1457
6	7u83	1458	`clear_exp_list(arg2);`
2	7u83	1459
6	7u83	1460	`if (name(arg1) == name_tag && isglob(son(arg1)) && !isvar(son(arg1))) {`
		1461	`speci sp;`
		1462	`/* check for substitutions for certain global procedures */`
		1463	`sp = special_fn(arg1, arg2.start, result_shape);`
		1464	`if (sp.is_special) {`
		1465	`return sp.special_exp;`
		1466	`}`
		1467	`}`
2	7u83	1468
6	7u83	1469	`if (arg2.number==0) {`
		1470	`setfather(res, arg1);`
		1471	`} else {`
		1472	`clearlast(arg1);`
		1473	`bro(arg1) = arg2.start;`
		1474	`setfather(res, arg2.end);`
2	7u83	1475	`#ifdef promote_pars`
6	7u83	1476	`promote_actuals(bro(son(res)));`
2	7u83	1477	`#endif`
6	7u83	1478	`}`
2	7u83	1479
6	7u83	1480	`/* rewrite struct/union value parameters as pointer-to-copy */`
		1481	`if (redo_structparams && arg2.number > 0) {`
		1482	`/* has >0 params */`
		1483	`exp param, prev;`
2	7u83	1484
6	7u83	1485	`prev = arg1;`
		1486	`param = bro(arg1);`
2	7u83	1487
6	7u83	1488	`while (1 /"break" below/) {`
		1489	`if ((varhack && last(param)) \|\|`
2	7u83	1490	`#if ishppa`
6	7u83	1491	`((name(sh(param)) == cpdhd \|\|`
		1492	`name(sh(param)) == nofhd \|\|`
		1493	`name(sh(param)) == doublehd) &&`
		1494	`(shape_size(sh(param)) > 64)))`
2	7u83	1495	`#else`
		1496	`#if issparc`
6	7u83	1497	`sparccpd(sh(param)))`
2	7u83	1498	`#else`
6	7u83	1499	`name(sh(param)) == cpdhd \|\|`
		1500	`name(sh(param)) == nofhd \|\|`
		1501	`name(sh(param)) == doublehd)`
2	7u83	1502	`#endif`
		1503	`#endif`
6	7u83	1504	`{`
		1505	`/*`
		1506	`* param IS struct/union-by-value,`
		1507	`* pass indirectly: make a local`
		1508	`* copy of param and in the`
		1509	`* parameter list replacce param by`
		1510	`* pointer to the copy.`
		1511	`*`
		1512	`* From:(apply_tag arg1 ...param...)`
		1513	`*`
		1514	`* Make:(new_ident param(apply_tag`
		1515	`* arg1 .... new_par ...))`
		1516	`* Where new_par =`
		1517	`* pointer-to-new_ident`
		1518	`*/`
		1519	`exp new_par, new_ident;`
		1520	`shape ptr_s =`
		1521	`f_pointer(f_alignment(sh(param)));`
2	7u83	1522
6	7u83	1523	`/* new_ident: (ident_tag sh=sh(res)`
		1524	`no=1 pt=new_par param res) */`
		1525	`new_ident = getexp(sh(res),`
		1526	`bro(res),`
		1527	`(int)last(res),`
		1528	`param, nilexp, 0,`
		1529	`1, ident_tag);`
2	7u83	1530
6	7u83	1531	`setvar(new_ident);`
		1532	`/* taking its address below*/`
2	7u83	1533
6	7u83	1534	`/* new_par: (name_tag sh=ptr_s pt=0`
		1535	`new_ident) */`
		1536	`new_par = getexp(ptr_s, bro(param),`
		1537	`(bool)last(param),`
		1538	`new_ident, nilexp,`
		1539	`0, 0, name_tag);`
		1540	`pt(new_ident) = new_par;`
		1541	`/* use of new new_ident by new_par*/`
		1542	`setlastuse(new_par);`
		1543	`/* ... is last-and-only use of`
		1544	`new_ident */`
2	7u83	1545
6	7u83	1546	`/* install res as body of`
		1547	`new_ident */`
		1548	`clearlast(param);`
		1549	`bro(param) = res;`
2	7u83	1550
6	7u83	1551	`setlast(res);`
		1552	`bro(res) = new_ident;`
2	7u83	1553
6	7u83	1554	`bro(prev) = new_par;`
2	7u83	1555
6	7u83	1556	`res = new_ident;`
		1557	`/* all done */`
2	7u83	1558
6	7u83	1559	`/* iteration */`
		1560	`if (last(new_par)) {`
		1561	`break;`
		1562	`}`
2	7u83	1563
6	7u83	1564	`param = bro(new_par);`
		1565	`prev = new_par;`
		1566	`} else {`
		1567	`/* iteration */`
		1568	`if (last(param)) {`
		1569	`break;`
		1570	`}`
2	7u83	1571
6	7u83	1572	`prev = param;`
		1573	`param = bro(param);`
		1574	`}`
		1575	`}`
		1576	`}`
2	7u83	1577
		1578
6	7u83	1579	`/* apply this transformation if the procedure has a structure-like`
		1580	`result and we want to make a new first parameter which is`
		1581	`a reference to where the result is to go. */`
		1582	`if (redo_structfns && !reg_result(result_shape)) {`
		1583	`/* replace f(x) by {var r; f(r, x); cont(r)} */`
		1584	`exp init, vardec, cont, contname, seq, app, appname, t;`
		1585	`exp_list list;`
		1586	`shape ptr_res_shape = f_pointer(f_alignment(result_shape));`
2	7u83	1587
6	7u83	1588	`init = getexp(result_shape, nilexp, 0, nilexp, nilexp, 0, 0,`
		1589	`clear_tag);`
		1590	`vardec = getexp(result_shape, nilexp, 0, init, nilexp, 0, 1,`
		1591	`ident_tag);`
		1592	`setvar(vardec);`
		1593	`contname = getexp(ptr_res_shape, nilexp, 0, vardec, nilexp, 0,`
		1594	`0, name_tag);`
		1595	`pt(vardec) = contname;`
		1596	`cont = f_contents(result_shape, contname);`
		1597	`appname = getexp(ptr_res_shape, bro(son(res)), 0, vardec,`
		1598	`contname, 0, 0, name_tag);`
		1599	`++no(vardec);`
		1600	`pt(vardec) = appname;`
		1601	`app = getexp(f_top, nilexp, 0, son(res), nilexp, 0, 32,`
		1602	`apply_tag);`
		1603	`if (last(son(res))) {`
		1604	`clearlast(son(res));`
		1605	`setlast(appname);`
		1606	`bro(appname) = app;`
		1607	`}`
		1608	`bro(son(res)) = appname;`
		1609	`t = son(app);`
		1610	`list.number = 1;`
		1611	`while (!last(t)) {`
		1612	`t = bro(t);`
		1613	`}`
		1614	`bro(t) = app;`
		1615	`list.start = app;`
		1616	`list.end = app;`
		1617	`seq = f_sequence(list, cont);`
		1618	`bro(init) = seq;`
		1619	`setfather(vardec, seq);`
		1620	`retcell(res);`
		1621	`return vardec;`
		1622	`}`
2	7u83	1623
6	7u83	1624	`return res;`
2	7u83	1625	`}`
		1626
6	7u83	1627
		1628	`exp`
		1629	`f_assign(exp arg1, exp arg2)`
2	7u83	1630	`{`
6	7u83	1631	`if (name(sh(arg1)) == bothd) {`
		1632	`kill_exp(arg2, arg2);`
		1633	`return arg1;`
		1634	`}`
		1635	`if (name(sh(arg2)) == bothd) {`
		1636	`kill_exp(arg1, arg1);`
		1637	`return arg2;`
		1638	`}`
2	7u83	1639
6	7u83	1640	`return me_b3(f_top, arg1, arg2, ass_tag);`
2	7u83	1641	`}`
		1642
6	7u83	1643
		1644	`exp`
		1645	`f_assign_with_mode(transfer_mode md, exp arg1, exp arg2)`
2	7u83	1646	`{`
6	7u83	1647	`if (name(sh(arg1)) == bothd) {`
		1648	`kill_exp(arg2, arg2);`
		1649	`return arg1;`
		1650	`}`
		1651	`if (name(sh(arg2)) == bothd) {`
		1652	`kill_exp(arg1, arg1);`
		1653	`return arg2;`
		1654	`}`
2	7u83	1655
6	7u83	1656	`if (md & f_complete) {`
		1657	`exp d = me_startid(f_top, arg2, 0);`
		1658	`return me_complete_id(d, f_assign_with_mode(md & ~f_complete,`
		1659	`arg1,`
		1660	`me_obtain(d)));`
		1661	`}`
2	7u83	1662	`#ifdef no_trap_on_nil_contents`
6	7u83	1663	`if ((md & f_trap_on_nil) != 0) {`
		1664	`exp d = me_startid(f_top, arg1, 0);`
2	7u83	1665	`exp hldr = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, 0);`
6	7u83	1666	`exp lb = getexp(f_top, nilexp, 0, hldr, nilexp, 0, 0,`
		1667	`labst_tag);`
2	7u83	1668	`exp_list el;`
		1669	`exp test = me_q1(no_nat_option, f_equal, &lb, me_obtain(d),`
6	7u83	1670	`f_make_null_ptr(al1_of(sh(arg1))), test_tag);`
		1671	`exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,`
		1672	`f_nil_access, trap_tag);`
2	7u83	1673	`md &= ~f_trap_on_nil;`
6	7u83	1674	`el = new_exp_list(1);`
		1675	`el = add_exp_list(el, test, 1);`
		1676	`return me_complete_id(d, f_conditional(&lb, f_sequence(el, trp),`
		1677	`f_assign_with_mode(md,`
		1678	`me_obtain(d), arg2)));`
		1679	`}`
2	7u83	1680	`#endif`
6	7u83	1681	`if ((md & f_volatile) != 0) {`
		1682	`return me_b3(f_top, arg1, arg2, assvol_tag);`
		1683	`} else if ((md & f_overlap) &&`
		1684	`(name(arg2) == cont_tag \|\| name(arg2) == contvol_tag) &&`
		1685	`!reg_result(sh(arg2))) {`
		1686	`return f_move_some(md, son(arg2), arg1,`
		1687	`f_shape_offset(sh(arg2)));`
		1688	`} else {`
		1689	`return me_b3(f_top, arg1, arg2, ass_tag);`
		1690	`}`
2	7u83	1691	`}`
		1692
6	7u83	1693
		1694	`exp`
		1695	`f_bitfield_assign(exp p, exp off, exp val)`
2	7u83	1696	`{`
6	7u83	1697	`exp res;`
		1698	`if (name(sh(p)) == bothd) {`
		1699	`return p;`
		1700	`}`
		1701	`if (name(sh(val)) == bothd) {`
		1702	`return val;`
		1703	`}`
2	7u83	1704
		1705	`#if check_shape`
6	7u83	1706	`if (name(sh(p)) != ptrhd \|\| name(sh(off)) != offsethd) {`
		1707	`failer(CHSH_BFASS);`
		1708	`}`
2	7u83	1709	`#endif`
6	7u83	1710	`if (name(off) == val_tag) {`
		1711	`res = me_b3(f_top, p, val, bfass_tag);`
		1712	`no(res) = no(off);`
		1713	`return res;`
		1714	`} else {`
		1715	`int alofptr = al1(sh(p));`
		1716	`shape s = containedshape(alofptr, 0);`
		1717	`shape bfs = sh(val);`
		1718	`int nbits = shape_size(sh(val));`
		1719	`alignment als = f_alignment(s);`
		1720	`alignment alb = long_to_al(1);`
		1721	`shape os = f_offset(als, als);`
		1722	`shape bos = f_offset(alb, alb);`
		1723	`exp mask0 = getexp(s, nilexp, 0, nilexp, nilexp, 0,`
		1724	`((1 << nbits) -1), val_tag);`
2	7u83	1725
6	7u83	1726	`exp noff1 = getexp(sh(off), nilexp, 0, nilexp, nilexp, 0, 0,`
		1727	`name_tag);`
		1728	`exp noff2 = getexp(sh(off), nilexp, 0, nilexp, noff1, 0, 0,`
		1729	`name_tag);`
		1730	`exp idoff = getexp(f_top, nilexp, 0, off, noff2, 0, 2,`
		1731	`ident_tag);`
		1732	`son(noff1) = idoff; son(noff2) = idoff;`
		1733	`{`
		1734	`exp addbf = f_offset_add(noff1, f_shape_offset(bfs));`
		1735	`exp byteoffinit = f_offset_subtract(hold_check(`
		1736	`f_offset_pad(als, addbf)),`
		1737	`hold_check(f_offset_pad(als,`
		1738	`f_shape_offset(s))));`
		1739	`exp v1bit = getexp(bos, nilexp, 0, nilexp, nilexp, 0, 1,`
		1740	`val_tag);`
		1741	`exp nby1 = getexp(os, nilexp, 0, nilexp, nilexp, 0, 0,`
		1742	`name_tag);`
		1743	`exp nby2 = getexp(os, nilexp, 0, nilexp, nby1, 0, 0,`
		1744	`name_tag);`
		1745	`exp nby3 = getexp(os, nilexp, 0, nilexp, nby2, 0, 0,`
		1746	`name_tag);`
		1747	`exp idby = getexp(f_top, idoff, 1, byteoffinit, nby3, 0,`
		1748	`3, ident_tag);`
		1749	`exp bitoffinit = f_offset_div(ulongsh,`
		1750	`f_offset_subtract(noff2,`
		1751	`f_offset_pad(f_alignment(bfs), nby2)),`
		1752	`v1bit);`
		1753	`exp bnt1 = getexp(ulongsh, nilexp, 0, nilexp, nilexp, 0,`
		1754	`0, name_tag);`
		1755	`exp bnt2 = getexp(ulongsh, nilexp, 0, nilexp, bnt1, 0,`
		1756	`0, name_tag);`
2	7u83	1757	`#if little_end`
6	7u83	1758	`exp idbnt = getexp(f_top, idby, 1, bitoffinit, bnt2, 0,`
		1759	`2, ident_tag);`
2	7u83	1760	`#else`
6	7u83	1761	`exp v = getexp(ulongsh, nilexp, 0, nilexp, nilexp, 0,`
		1762	`shape_size(s) - nbits, val_tag);`
		1763	`exp idbnt = getexp(f_top, idby, 1, f_minus(f_wrap, v,`
		1764	`bitoffinit),`
		1765	`bnt2, 0, 2, ident_tag);`
2	7u83	1766	`#endif`
6	7u83	1767	`exp pn1 = getexp(sh(p), nilexp, 0, nilexp, nilexp, 0, 0,`
		1768	`name_tag);`
		1769	`exp pn2 = getexp(sh(p), nilexp, 0, nilexp, pn1, 0, 0,`
		1770	`name_tag);`
		1771	`exp idpn = getexp(f_top, idbnt, 1,`
		1772	`f_add_to_ptr(p, nby1), pn2, 0, 2,`
		1773	`ident_tag);`
2	7u83	1774
6	7u83	1775	`exp cnt; exp mask1; exp orit; exp asit;`
		1776	`son(nby1) = idby; son(nby2) = idby; son(nby3) = idby;`
		1777	`son(bnt1) = idbnt; son(bnt2) = idbnt;`
		1778	`son(pn1) = idpn; son(pn2) = idpn;`
		1779	`bro(son(idby)) = idbnt; clearlast(son(idby));`
		1780	`bro(son(idbnt)) = idpn; clearlast(son(idbnt));`
		1781	`bro(son(idoff)) = idby; clearlast(son(idoff));`
2	7u83	1782
6	7u83	1783	`mask1 = f_not(f_shift_left(f_wrap, mask0, bnt1));`
		1784	`cnt = f_and(f_contents(s, pn1), mask1);`
		1785	`orit = f_or(cnt, f_shift_left(f_wrap,`
		1786	`f_change_bitfield_to_int(s, val), bnt2));`
		1787	`asit = f_assign(pn2, orit);`
		1788	`bro(son(idpn)) = asit; clearlast(son(idpn));`
		1789	`bro(asit) = idpn; setlast(asit);`
2	7u83	1790
6	7u83	1791	`return idoff;`
		1792	`}`
		1793	`}`
2	7u83	1794	`}`
		1795
6	7u83	1796
		1797	`exp`
		1798	`f_bitfield_assign_with_mode(transfer_mode md, exp p, exp off, exp val)`
2	7u83	1799	`{`
6	7u83	1800	`exp res;`
		1801	`if (name(sh(p)) == bothd) {`
		1802	`return p;`
		1803	`}`
		1804	`if (name(sh(val)) == bothd) {`
		1805	`return val;`
		1806	`}`
2	7u83	1807
6	7u83	1808	`if (md == f_standard_transfer_mode) {`
		1809	`return f_bitfield_assign(p, off, val);`
		1810	`}`
2	7u83	1811
		1812	`#if check_shape`
6	7u83	1813	`if (name(sh(p)) != ptrhd \|\| name(sh(off)) != offsethd \|\|`
		1814	`name(off) != val_tag) {`
		1815	`failer(CHSH_BFASS);`
		1816	`}`
2	7u83	1817	`#endif`
		1818	`#ifdef no_trap_on_nil_contents`
6	7u83	1819	`if ((md & f_trap_on_nil) != 0) {`
2	7u83	1820	`exp d = me_startid(f_top, p, 0);`
		1821	`exp hldr = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, 0);`
6	7u83	1822	`exp lb = getexp(f_top, nilexp, 0, hldr, nilexp, 0, 0,`
		1823	`labst_tag);`
2	7u83	1824	`exp_list el;`
		1825	`exp test = me_q1(no_nat_option, f_equal, &lb, me_obtain(d),`
6	7u83	1826	`f_make_null_ptr(al1_of(sh(p))), test_tag);`
		1827	`exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,`
		1828	`f_nil_access, trap_tag);`
2	7u83	1829	`md &= ~f_trap_on_nil;`
6	7u83	1830	`el = new_exp_list(1);`
		1831	`el = add_exp_list(el, test, 1);`
		1832	`return me_complete_id(d, f_conditional(&lb, f_sequence(el, trp),`
		1833	`f_bitfield_assign_with_mode(md, me_obtain(d), off, val)));`
		1834	`}`
2	7u83	1835	`#endif`
6	7u83	1836	`if (md & f_volatile) {`
		1837	`res = me_b3(f_top, p, val, bfassvol_tag);`
		1838	`} else {`
		1839	`res = me_b3(f_top, p, val, bfass_tag);`
		1840	`}`
		1841	`no(res) = no(off);`
		1842	`return res;`
2	7u83	1843	`}`
		1844
6	7u83	1845	`exp`
		1846	`f_bitfield_contents(bitfield_variety bf, exp p, exp off)`
2	7u83	1847	`{`
6	7u83	1848	`exp res;`
		1849	`if (name(sh(p)) == bothd) {`
		1850	`return off;`
		1851	`}`
		1852	`if (name(sh(off)) == bothd) {`
		1853	`return p;`
		1854	`}`
2	7u83	1855
		1856	`#if check_shape`
6	7u83	1857	`if (name(sh(p)) != ptrhd \|\| name(sh(off)) != offsethd)`
		1858	`failer(CHSH_BFCONT);`
2	7u83	1859	`#endif`
		1860
6	7u83	1861	`if (name(off) == val_tag) {`
		1862	`res = me_u3(f_bitfield(bf), p, bfcont_tag);`
		1863	`no(res) = no(off);`
		1864	`return res;`
		1865	`} else {`
		1866	`int alofptr = al1(sh(p));`
		1867	`shape s = containedshape(alofptr, bf.has_sign);`
		1868	`shape bfs = f_bitfield(bf);`
		1869	`alignment als = f_alignment(s);`
		1870	`alignment alb = long_to_al(1);`
		1871	`shape ob = f_offset(alb, alb);`
		1872	`shape os = f_offset(als, als);`
		1873	`exp noff1 = getexp(sh(off), nilexp, 0, nilexp, nilexp, 0, 0,`
		1874	`name_tag);`
		1875	`exp noff2 = getexp(sh(off), nilexp, 0, nilexp, noff1, 0, 0,`
		1876	`name_tag);`
		1877	`exp idoff = getexp(s, nilexp, 0, off, noff2, 0, 2, ident_tag);`
		1878	`son(noff1) = idoff; son(noff2) = idoff;`
		1879	`{`
		1880	`exp addbf = f_offset_add(noff1, f_shape_offset(bfs));`
		1881	`exp byteoffinit =`
		1882	`f_offset_subtract(hold_check(f_offset_pad(als,`
		1883	`addbf)), hold_check(f_offset_pad(als,`
		1884	`f_shape_offset(s))));`
		1885	`exp nby1 = getexp(os, nilexp, 0, nilexp, nilexp, 0, 0,`
		1886	`name_tag);`
		1887	`exp nby2 = getexp(os, nilexp, 0, nilexp, nby1, 0, 0,`
		1888	`name_tag);`
		1889	`exp idby = getexp(s, nilexp, 0, byteoffinit, nby2, 0, 2,`
		1890	`ident_tag);`
		1891	`exp cnt; exp sh1; exp sh2; exp bitoff; exp shl;`
		1892	`exp v = getexp(ulongsh, nilexp, 0, nilexp, nilexp, 0,`
		1893	`shape_size(s) - bf.bits, val_tag);`
		1894	`exp v1bit = getexp(ob, nilexp, 0, nilexp, nilexp, 0, 1,`
		1895	`val_tag);`
		1896	`son(nby1) = idby; son(nby2) = idby;`
		1897	`cnt = f_contents(s, f_add_to_ptr(p, nby1));`
		1898	`bitoff =`
		1899	`f_offset_div(ulongsh, f_offset_subtract(noff2,`
		1900	`f_offset_pad(f_alignment(bfs), nby2)), v1bit);`
2	7u83	1901	`#if (little_end)`
6	7u83	1902	`shl = f_minus(f_wrap, copy(v), bitoff);`
2	7u83	1903	`#else`
6	7u83	1904	`shl = bitoff;`
2	7u83	1905	`#endif`
6	7u83	1906	`sh1 = f_shift_left(f_wrap, cnt, shl);`
		1907	`sh2 = f_shift_right(sh1, v);`
		1908	`bro(byteoffinit) = sh2; clearlast(byteoffinit);`
		1909	`bro(sh2) = idby; setlast(sh2);`
		1910	`bro(off) = idby; clearlast(off);`
		1911	`bro(idby) = idoff; setlast(idby);`
		1912	`return (f_change_int_to_bitfield(bf, idoff));`
		1913	`}`
		1914	`}`
2	7u83	1915	`}`
		1916
6	7u83	1917
		1918	`exp`
		1919	`f_bitfield_contents_with_mode(transfer_mode md, bitfield_variety bf, exp p,`
		1920	`exp off)`
2	7u83	1921	`{`
6	7u83	1922	`exp res;`
		1923	`if (name(sh(p)) == bothd) {`
		1924	`return p;`
		1925	`}`
2	7u83	1926
		1927	`#if check_shape`
6	7u83	1928	`if (name(sh(p)) != ptrhd \|\| name(sh(off)) != offsethd \|\|`
		1929	`name(off) != val_tag) {`
		1930	`failer(CHSH_BFCONT);`
		1931	`}`
2	7u83	1932	`#endif`
		1933	`#ifdef no_trap_on_nil_contents`
		1934	`if ((md & f_trap_on_nil) != 0) {`
		1935	`exp d = me_startid(f_bitfield(bf), p, 0);`
		1936	`exp hldr = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, 0);`
6	7u83	1937	`exp lb = getexp(f_top, nilexp, 0, hldr, nilexp, 0, 0,`
		1938	`labst_tag);`
2	7u83	1939	`exp_list el;`
		1940	`exp test = me_q1(no_nat_option, f_equal, &lb, me_obtain(d),`
6	7u83	1941	`f_make_null_ptr(al1_of(sh(p))), test_tag);`
		1942	`exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,`
		1943	`f_nil_access, trap_tag);`
2	7u83	1944	`md &= ~f_trap_on_nil;`
6	7u83	1945	`el = new_exp_list(1);`
		1946	`el = add_exp_list(el, test, 1);`
		1947	`return me_complete_id(d, f_conditional(&lb, f_sequence(el, trp),`
		1948	`f_bitfield_contents_with_mode(md, bf, me_obtain(d), off)));`
		1949	`}`
2	7u83	1950	`#endif`
		1951
6	7u83	1952	`if (md == f_volatile) {`
		1953	`res = me_u3(f_bitfield(bf), p, bfcontvol_tag);`
		1954	`} else {`
		1955	`res = me_u3(f_bitfield(bf), p, bfcont_tag);`
		1956	`}`
		1957	`no(res) = no(off);`
		1958	`return res;`
2	7u83	1959	`}`
		1960
		1961
		1962	`#if do_case_transforms`
		1963
6	7u83	1964	`exp`
		1965	`f_case(bool exhaustive, exp control, caselim_list branches)`
2	7u83	1966	`{`
6	7u83	1967	`exp r, ht;`
		1968	`shape case_shape;`
		1969	`exp changer;`
		1970	`exp body_of_ident;`
		1971	`exp control_expression;`
		1972	`exp body_of_case;`
		1973	`exp id;`
		1974	`exp copy_ce;`
		1975	`shape changer_shape = (shape_size(sh(control)) >= SLONG_SZ) ?`
		1976	`sh(control) : is_signed(sh(control)) ? slongsh : ulongsh;`
2	7u83	1977
6	7u83	1978	`/* UNUSED(branches);`
		1979	`*/`
		1980	`if (name(sh(control)) == bothd) {`
		1981	`return control;`
		1982	`}`
2	7u83	1983
6	7u83	1984	`bro(global_case) = nilexp;`
		1985	`while (branches != nilexp) {`
		1986	`exp hd = branches;`
		1987	`branches = bro(branches);`
		1988	`bro(hd) = nilexp;`
		1989	`sh(hd) = sh(control);`
		1990	`if (son(hd) != nilexp) {`
		1991	`sh(son(hd)) = sh(control);`
		1992	`}`
		1993	`if (son(hd) != nilexp &&`
		1994	`docmp_f((int)f_less_than, son(hd), hd)) {`
		1995	`--no(son(pt(hd)));`
		1996	`retcell(son(hd));`
		1997	`retcell(hd);`
		1998	`} else {`
		1999	`case_item(hd);`
		2000	`}`
		2001	`}`
2	7u83	2002
6	7u83	2003	`if (bro(global_case) == nilexp) {`
		2004	`return control;`
		2005	`}`
		2006	`case_shape = (exhaustive)? f_bottom : f_top;`
2	7u83	2007
6	7u83	2008	`if (PIC_code) {`
		2009	`proc_externs = 1;`
2	7u83	2010	`}`
		2011
		2012	`#if check_shape`
6	7u83	2013	`if (!is_integer(sh(control))) {`
		2014	`failer(CHSH_CASE);`
		2015	`}`
2	7u83	2016	`#endif`
		2017
6	7u83	2018	`r = getexp(case_shape, nilexp, 0, control, nilexp, 0, 0, case_tag);`
		2019	`clearlast(control);`
		2020	`bro(control) = bro(global_case);`
		2021	`ht = control;`
		2022	`while (bro(ht) != nilexp) {`
		2023	`ht = bro(ht);`
		2024	`sh(ht) = changer_shape;`
		2025	`if (son(ht) != nilexp) {`
		2026	`sh(son(ht)) = changer_shape;`
		2027	`}`
		2028	`}`
		2029	`setlast(ht);`
		2030	`bro(ht) = r;`
2	7u83	2031
6	7u83	2032	`control_expression = son(r);`
		2033	`body_of_case = bro(son(r));`
2	7u83	2034
6	7u83	2035	`copy_ce = copy(control_expression);`
		2036	`changer = hold_check(me_u3(changer_shape, control_expression,`
		2037	`chvar_tag));`
		2038	`id = me_startid(sh(changer), changer, 1);`
2	7u83	2039	`/* the shape of the ident will be overwritten by me_complete_id */`
6	7u83	2040	`body_of_ident = case_optimisation(body_of_case, id, sh(r), copy_ce);`
		2041	`id = me_complete_id(id, body_of_ident);`
2	7u83	2042
		2043	`#ifdef NEWDIAGS`
6	7u83	2044	`if (extra_diags) {`
		2045	`id = f_dg_exp(id, f_branch_dg(f_dg_null_sourcepos));`
		2046	`}`
2	7u83	2047	`#endif`
		2048
6	7u83	2049	`return (hold_check(id));`
2	7u83	2050	`}`
		2051
6	7u83	2052	`#else /* do_case_transforms */`
2	7u83	2053
6	7u83	2054	`exp`
		2055	`f_case(bool exhaustive, exp control, caselim_list branches)`
2	7u83	2056	`{`
6	7u83	2057	`exp r, ht;`
		2058	`shape case_shape;`
		2059	`/* UNUSED(branches);`
		2060	`if (name(sh(control)) == bothd \|\| bro(global_case) == nilexp)`
		2061	`return control;`
		2062	`*/`
		2063	`if (name(sh(control)) == bothd) {`
		2064	`return control;`
		2065	`}`
2	7u83	2066
6	7u83	2067	`bro(global_case) = nilexp;`
		2068	`while (branches != nilexp) {`
		2069	`exp hd = branches;`
		2070	`branches = bro(branches);`
		2071	`bro(hd) = nilexp;`
		2072	`sh(hd) = sh(control);`
		2073	`if (son(hd) != nilexp) {`
		2074	`sh(son(hd)) = sh(control);`
		2075	`}`
		2076	`if (son(hd) != nilexp &&`
		2077	`docmp_f((int)f_less_than, son(hd), hd)) {`
		2078	`--no(son(pt(hd)));`
		2079	`retcell(son(hd));`
		2080	`retcell(hd);`
		2081	`} else {`
		2082	`case_item(hd);`
		2083	`}`
2	7u83	2084	`}`
6	7u83	2085	`if (bro(global_case) == nilexp) {`
		2086	`return control;`
		2087	`}`
		2088	`case_shape = (exhaustive) ? f_bottom : f_top;`
2	7u83	2089
6	7u83	2090	`if (PIC_code) {`
		2091	`proc_externs = 1;`
		2092	`}`
2	7u83	2093
		2094	`#if check_shape`
6	7u83	2095	`if (!is_integer(sh(control))) {`
		2096	`failer(CHSH_CASE);`
		2097	`}`
2	7u83	2098	`#endif`
		2099
6	7u83	2100	`r = getexp(case_shape, nilexp, 0, control, nilexp, 0, 0, case_tag);`
		2101	`clearlast(control);`
		2102	`bro(control) = bro(global_case);`
		2103	`ht = control;`
		2104	`while (bro(ht) != nilexp) {`
		2105	`ht = bro(ht);`
		2106	`sh(ht) = sh(control);`
		2107	`if (son(ht) != nilexp) {`
		2108	`sh(son(ht)) = sh(control);`
		2109	`}`
		2110	`}`
		2111	`setlast(ht);`
		2112	`bro(ht) = r;`
2	7u83	2113
		2114	`#ifdef NEWDIAGS`
6	7u83	2115	`if (extra_diags) {`
		2116	`r = f_dg_exp(r, f_branch_dg(f_dg_null_sourcepos));`
		2117	`}`
2	7u83	2118	`#endif`
		2119
6	7u83	2120	`return (r);`
2	7u83	2121	`}`
6	7u83	2122	`#endif /* do_case_transforms */`
2	7u83	2123
		2124
6	7u83	2125	`exp`
		2126	`f_change_bitfield_to_int(variety x, exp arg1)`
2	7u83	2127	`{`
6	7u83	2128	`if (name(sh(arg1)) == bothd) {`
		2129	`return arg1;`
		2130	`}`
2	7u83	2131
		2132	`#if check_shape`
6	7u83	2133	`if (name(sh(arg1)) != bitfhd) {`
		2134	`failer(CHSH_CHBITFIELD);`
		2135	`}`
2	7u83	2136	`#endif`
		2137	`#if !has64bits`
6	7u83	2138	`if (shape_size(x) >32) {`
		2139	`shape n32 = (is_signed(x)) ? slongsh : ulongsh;`
2	7u83	2140	`exp z = hold_check(me_c2(n32, arg1, bitf_to_int_tag));`
		2141	`return f_change_variety(f_impossible, x, z);`
		2142	`}`
		2143	`#endif`
6	7u83	2144	`return me_c2(f_integer(x), arg1, bitf_to_int_tag);`
2	7u83	2145	`}`
		2146
		2147
6	7u83	2148	`exp`
		2149	`f_change_int_to_bitfield(bitfield_variety x, exp arg1)`
2	7u83	2150	`{`
6	7u83	2151	`if (name(sh(arg1)) == bothd) {`
		2152	`return arg1;`
		2153	`}`
2	7u83	2154
		2155	`#if check_shape`
6	7u83	2156	`if (!is_integer(sh(arg1))) {`
		2157	`failer(CHSH_CHINTBF);`
		2158	`}`
2	7u83	2159	`#endif`
		2160	`#if !has64bits`
6	7u83	2161	`if (shape_size(sh(arg1)) >32) {`
		2162	`shape n32 = (is_signed(sh(arg1))) ? slongsh : ulongsh;`
2	7u83	2163	`arg1 = hold_check(f_change_variety(f_wrap, n32, arg1));`
		2164	`}`
		2165	`#endif`
		2166
6	7u83	2167	`return me_c2(f_bitfield(x), arg1, int_to_bitf_tag);`
2	7u83	2168	`}`
		2169
6	7u83	2170
		2171
		2172	`exp`
		2173	`f_change_variety(error_treatment ov_err, variety r, exp arg1)`
2	7u83	2174	`{`
6	7u83	2175	`if (name(sh(arg1)) == bothd) {`
		2176	`return arg1;`
		2177	`}`
2	7u83	2178
		2179	`#if check_shape`
6	7u83	2180	`if (!is_integer(sh(arg1))) {`
		2181	`failer(CHSH_CHVAR);`
		2182	`}`
2	7u83	2183	`#endif`
		2184	`#if !has64bits`
6	7u83	2185	`if ((name(arg1) != val_tag \|\| ov_err.err_code > 2) &&`
		2186	`(shape_size(sh(arg1)) > 32 \|\| name(r) >=s64hd) &&`
		2187	`name(sh(arg1)) != name(r)) {`
		2188	`exp e = arg1;`
		2189	`int ss = is_signed(sh(arg1));`
		2190	`int sd = is_signed(r);`
		2191	`shape x = (ss)?slongsh:ulongsh;`
		2192	`if (shape_size(sh(arg1)) <= 32) {`
		2193	`exp e = hold_check(me_c1(x, ov_err, arg1, chvar_tag));`
		2194	`exp z = TDFcallaux(ov_err, e, (sd) ? ((ss) ?`
		2195	`"__TDFUsswiden" : "__TDFUuswiden") : (ss) ?`
		2196	`"__TDFUsuwiden" : "__TDFUuuwiden", r);`
		2197	`return z;`
		2198	`} else if (name(r) >= s64hd) {`
		2199	`return TDFcallaux(ov_err, e, (sd) ? "__TDFUu642s64" :`
		2200	`"__TDFUs642u64", r);`
		2201	`} else {`
		2202	`exp e = TDFcallaux(ov_err, arg1, (sd) ?`
		2203	`((ss) ? "__TDFUssshorten" : "__TDFUusshorten") :`
		2204	`(ss) ? "__TDFUsushorten" : "__TDFUuushorten",`
		2205	`(sd) ? slongsh : ulongsh);`
		2206	`return hold_check(me_c1(f_integer(r), ov_err, e,`
		2207	`chvar_tag));`
		2208	`}`
		2209	`}`
2	7u83	2210	`#endif`
6	7u83	2211	`return me_c1(f_integer(r), ov_err, arg1, chvar_tag);`
2	7u83	2212	`}`
		2213
		2214
6	7u83	2215	`exp`
		2216	`f_component(shape sha, exp arg1, exp arg2)`
2	7u83	2217	`{`
6	7u83	2218	`if (name(sh(arg1)) == bothd) {`
		2219	`kill_exp(arg2, arg2);`
		2220	`return arg1;`
		2221	`}`
		2222	`if (name(sh(arg2)) == bothd) {`
		2223	`kill_exp(arg1, arg1);`
		2224	`return arg2;`
		2225	`}`
2	7u83	2226
		2227	`#if check_shape`
6	7u83	2228	`if (!doing_aldefs &&`
		2229	`(name(sh(arg2)) != offsethd \|\| name(sh(arg1)) != cpdhd \|\|`
		2230	`shape_align(sh(arg1)) < al1(sh(arg2)) \|\|`
		2231	`shape_align(sha) > al2(sh(arg2)))) {`
		2232	`failer(CHSH_COMPONENT);`
		2233	`}`
2	7u83	2234	`#endif`
		2235
6	7u83	2236	`return me_b3(sha, arg1, arg2, component_tag);`
2	7u83	2237	`}`
		2238
6	7u83	2239
		2240	`exp`
		2241	`f_concat_nof(exp arg1, exp arg2)`
2	7u83	2242	`{`
6	7u83	2243	`shape sha = getshape(0, const_al1, al2_of(sh(arg1)), align_of(sh(arg1)),`
		2244	`shape_size(sh(arg1)) + shape_size(sh(arg2)),`
		2245	`nofhd);`
		2246	`if (name(sh(arg1)) == bothd) {`
		2247	`kill_exp(arg2, arg2);`
		2248	`return arg1;`
		2249	`}`
		2250	`if (name(sh(arg2)) == bothd) {`
		2251	`kill_exp(arg1, arg1);`
		2252	`return arg2;`
		2253	`}`
2	7u83	2254
		2255	`/* al2_of(sh(arg1)) is the shapemacs.h hd of the nof shape */`
		2256	`#if check_shape`
6	7u83	2257	`if (!doing_aldefs && (shape_align(sh(arg1)) != shape_align(sh(arg2)))) {`
		2258	`failer(CHSH_CONCATNOF);`
		2259	`}`
2	7u83	2260	`#endif`
		2261
6	7u83	2262	`return me_b3(sha, arg1, arg2, concatnof_tag);`
2	7u83	2263	`}`
		2264
6	7u83	2265
		2266	`exp`
		2267	`f_conditional(label alt_label_intro, exp first, exp alt)`
2	7u83	2268	`{`
6	7u83	2269	`shape res_shape;`
		2270	`exp r, labst, def;`
		2271	`labst = get_lab(alt_label_intro);`
2	7u83	2272
6	7u83	2273	`res_shape = lub_shape(sh(first), sh(alt));`
		2274	`r = getexp(res_shape, nilexp, 0, first, nilexp, 0, 0, cond_tag);`
		2275	`def = son(labst);`
		2276	`setbro(first, labst);`
		2277	`clearlast(first);`
		2278	`setbro(def, alt);`
		2279	`clearlast(def);`
		2280	`setbro(alt, labst);`
		2281	`setlast(alt);`
		2282	`setsh(labst, sh(alt));`
		2283	`setfather(r, labst);`
		2284	`default_freq = (float)(2.0 * default_freq);`
		2285	`return r;`
2	7u83	2286	`}`
		2287
6	7u83	2288
		2289	`void`
		2290	`start_conditional(label alt_label_intro)`
2	7u83	2291	`{`
6	7u83	2292	`exp tg;`
		2293	`exp labst;`
		2294	`tg = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, clear_tag);`
		2295	`labst = getexp(f_bottom, nilexp, 0, tg, nilexp, 0, 0, labst_tag);`
		2296	`default_freq = (float)(default_freq / 2.0);`
		2297	`fno(labst) = default_freq;`
		2298	`++proc_label_count;`
		2299	`set_lab(alt_label_intro, labst);`
		2300	`return;`
2	7u83	2301	`}`
		2302
6	7u83	2303
		2304	`exp`
		2305	`f_contents(shape s, exp arg1)`
2	7u83	2306	`{`
6	7u83	2307	`if (name(sh(arg1)) == bothd) {`
		2308	`return arg1;`
		2309	`}`
2	7u83	2310
		2311	`#if check_shape`
6	7u83	2312	`if (!doing_aldefs &&`
		2313	`(name(sh(arg1)) != ptrhd \|\|`
		2314	`(al1(sh(arg1)) < shape_align(s)`
2	7u83	2315	`#if issparc`
6	7u83	2316	`&& align_of(s) != REAL_ALIGN`
2	7u83	2317	`#endif`
6	7u83	2318	`))) {`
		2319	`failer(CHSH_CONTENTS);`
		2320	`}`
2	7u83	2321	`#endif`
		2322
6	7u83	2323	`return me_c2(s, arg1, cont_tag);`
		2324	`}`
2	7u83	2325
		2326
6	7u83	2327	`exp`
		2328	`f_contents_with_mode(transfer_mode md, shape s, exp arg1)`
2	7u83	2329	`{`
6	7u83	2330	`if (name(sh(arg1)) == bothd) {`
		2331	`return arg1;`
		2332	`}`
2	7u83	2333
		2334	`#if check_shape`
6	7u83	2335	`if (!doing_aldefs &&`
		2336	`(name(sh(arg1)) != ptrhd \|\|`
		2337	`(al1(sh(arg1)) < shape_align(s) &&`
		2338	`al1_of(sh(arg1))->al.sh_hd != doublehd))) {`
		2339	`failer(CHSH_CONTENTS_VOL);`
		2340	`}`
2	7u83	2341	`#endif`
		2342	`#ifdef no_trap_on_nil_contents`
		2343	`if ((md & f_trap_on_nil) != 0) {`
		2344	`exp d = me_startid(s, arg1, 0);`
		2345	`exp hldr = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, 0);`
6	7u83	2346	`exp lb = getexp(f_top, nilexp, 0, hldr, nilexp, 0, 0,`
		2347	`labst_tag);`
2	7u83	2348	`exp_list el;`
		2349	`exp test = me_q1(no_nat_option, f_equal, &lb, me_obtain(d),`
6	7u83	2350	`f_make_null_ptr(f_alignment(s)), test_tag);`
		2351	`exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,`
		2352	`f_nil_access, trap_tag);`
2	7u83	2353	`md &= ~f_trap_on_nil;`
6	7u83	2354	`el = new_exp_list(1);`
		2355	`el = add_exp_list(el, test, 1);`
		2356	`return me_complete_id(d, f_conditional(&lb, f_sequence(el, trp),`
		2357	`f_contents_with_mode(md, s, me_obtain(d))));`
		2358	`}`
2	7u83	2359	`#endif`
6	7u83	2360	`if (md & f_volatile) {`
		2361	`return me_c2(s, arg1, contvol_tag);`
		2362	`} else {`
		2363	`return me_c2(s, arg1, cont_tag);`
		2364	`}`
2	7u83	2365	`}`
		2366
6	7u83	2367
		2368	`exp`
		2369	`f_current_env(void)`
2	7u83	2370	`{`
6	7u83	2371	`if (!in_proc_def) {`
		2372	`failer("current_env must be in proc definition");`
		2373	`}`
		2374	`uses_crt_env = 1;`
		2375	`uses_loc_address = 1;`
		2376	`return getexp(f_pointer(frame_alignment), nilexp, 0, nilexp, nilexp, 0,`
		2377	`0, current_env_tag);`
2	7u83	2378	`}`
		2379
6	7u83	2380
		2381	`int`
		2382	`eq_et(error_treatment a, error_treatment b)`
2	7u83	2383	`{`
6	7u83	2384	`return (a.err_code == b.err_code &&`
		2385	`(a.err_code != 4 \|\| a.jmp_dest == b.jmp_dest));`
2	7u83	2386	`}`
		2387
6	7u83	2388
		2389	`exp`
		2390	`div_rem(error_treatment div0_err, error_treatment ov_err, exp arg1, exp arg2,`
		2391	`exp(*f)(error_treatment, exp, exp))`
2	7u83	2392	`{`
		2393	`if (eq_et(div0_err, ov_err) \|\| eq_et(ov_err, f_impossible)) {`
		2394	`return f(div0_err, arg1, arg2);`
6	7u83	2395	`} else if (eq_et(div0_err, f_impossible)) {`
2	7u83	2396	`return f(ov_err, arg1, arg2);`
6	7u83	2397	`} else {`
2	7u83	2398	`exp da2 = me_startid(sh(arg1), arg2, 0);`
		2399	`exp hldr = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, 0);`
6	7u83	2400	`exp lb = getexp(f_top, nilexp, 0, hldr, nilexp, 0, 0,`
		2401	`labst_tag);`
2	7u83	2402	`exp tst = f_integer_test(no_nat_option, f_equal, &lb,`
6	7u83	2403	`me_obtain(da2), me_shint(sh(arg2), 0));`
2	7u83	2404	`exp_list st;`
		2405	`exp wrong;`
		2406	`st = new_exp_list(1);`
6	7u83	2407	`st = add_exp_list(st, tst, 0);`
2	7u83	2408	`if (div0_err.err_code == 4) {`
		2409	`wrong = f_goto(div0_err.jmp_dest);`
6	7u83	2410	`} else if (div0_err.err_code > 4) {`
2	7u83	2411	`wrong = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,`
6	7u83	2412	`f_overflow, trap_tag);`
		2413	`} else {`
2	7u83	2414	`wrong = me_shint(sh(arg1), 0);`
		2415	`}`
6	7u83	2416	`return me_complete_id(da2, f_conditional(&lb, f_sequence(st,`
		2417	`wrong), f(ov_err, arg1, me_obtain(da2))));`
2	7u83	2418	`}`
		2419	`}`
		2420
6	7u83	2421
		2422	`exp`
		2423	`div0_aux(error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	2424	`{`
		2425	`#if !has64bits`
		2426	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	2427	`(name(arg1) != val_tag \|\| name(arg2) != val_tag \|\|`
		2428	`ov_err.err_code > 2)) {`
		2429	`return TDFcallop2(ov_err, arg1, arg2, div0_tag);`
2	7u83	2430	`}`
		2431	`#endif`
		2432	`#if div0_implemented`
6	7u83	2433	`return me_b1(ov_err, arg1, arg2, div0_tag);`
2	7u83	2434	`#else`
6	7u83	2435	`if (name(arg2) == val_tag && !isbigval(arg2)) {`
		2436	`int n = no(arg2);`
		2437	`if ((n & (n - 1)) == 0) {`
		2438	`return me_b1(ov_err, arg1, arg2, div1_tag);`
		2439	`}`
		2440	`}`
		2441	`return me_b1(ov_err, arg1, arg2, div2_tag);`
2	7u83	2442	`#endif`
		2443	`}`
6	7u83	2444
		2445
		2446	`exp`
		2447	`f_div0(error_treatment div0_err, error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	2448	`{`
6	7u83	2449	`if (name(sh(arg1)) == bothd) {`
		2450	`kill_exp(arg2, arg2);`
		2451	`return arg1;`
		2452	`}`
		2453	`if (name(sh(arg2)) == bothd) {`
		2454	`kill_exp(arg1, arg1);`
		2455	`return arg2;`
		2456	`}`
2	7u83	2457
		2458	`#if check_shape`
6	7u83	2459	`if (!eq_shape(sh(arg1), sh(arg2)) \|\| !is_integer(sh(arg1))) {`
		2460	`failer(CHSH_DIV0);`
		2461	`}`
2	7u83	2462	`#endif`
6	7u83	2463	`return div_rem(div0_err, ov_err, arg1, arg2, div0_aux);`
2	7u83	2464	`}`
		2465
6	7u83	2466
		2467	`exp`
		2468	`div1_aux(error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	2469	`{`
		2470	`#if !has64bits`
6	7u83	2471	`if (name(sh(arg1)) >= s64hd &&`
		2472	`(name(arg1) != val_tag \|\| name(arg2) != val_tag \|\|`
		2473	`ov_err.err_code > 2)) {`
		2474	`return TDFcallop2(ov_err, arg1, arg2, div1_tag);`
2	7u83	2475	`}`
		2476	`#endif`
6	7u83	2477	`return me_b1(ov_err, arg1, arg2, div1_tag);`
2	7u83	2478	`}`
		2479
6	7u83	2480
		2481	`exp`
		2482	`f_div1(error_treatment div0_err, error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	2483	`{`
6	7u83	2484	`if (name(sh(arg1)) == bothd) {`
		2485	`kill_exp(arg2, arg2);`
		2486	`return arg1;`
		2487	`}`
		2488	`if (name(sh(arg2)) == bothd) {`
		2489	`kill_exp(arg1, arg1);`
		2490	`return arg2;`
		2491	`}`
2	7u83	2492
		2493	`#if check_shape`
6	7u83	2494	`if (!eq_shape(sh(arg1), sh(arg2)) \|\| !is_integer(sh(arg1))) {`
		2495	`failer(CHSH_DIV1);`
		2496	`}`
2	7u83	2497	`#endif`
		2498
6	7u83	2499	`return div_rem(div0_err, ov_err, arg1, arg2, div1_aux);`
2	7u83	2500	`}`
		2501
6	7u83	2502
		2503	`exp`
		2504	`div2_aux(error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	2505	`{`
		2506	`#if !has64bits`
		2507	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	2508	`(name(arg1) != val_tag \|\| name(arg2) != val_tag \|\|`
		2509	`ov_err.err_code > 2)) {`
		2510	`return TDFcallop2(ov_err, arg1, arg2, div2_tag);`
2	7u83	2511	`}`
		2512	`#endif`
6	7u83	2513	`return me_b1(ov_err, arg1, arg2, div2_tag);`
2	7u83	2514	`}`
		2515
6	7u83	2516	`exp`
		2517	`f_div2(error_treatment div0_err, error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	2518	`{`
6	7u83	2519	`if (name(sh(arg1)) == bothd) {`
		2520	`kill_exp(arg2, arg2);`
		2521	`return arg1;`
		2522	`}`
		2523	`if (name(sh(arg2)) == bothd) {`
		2524	`kill_exp(arg1, arg1);`
		2525	`return arg2;`
		2526	`}`
2	7u83	2527
		2528	`#if check_shape`
6	7u83	2529	`if (!eq_shape(sh(arg1), sh(arg2)) \|\| !is_integer(sh(arg1))) {`
		2530	`failer(CHSH_DIV2);`
		2531	`}`
2	7u83	2532	`#endif`
6	7u83	2533	`return div_rem(div0_err, ov_err, arg1, arg2, div2_aux);`
2	7u83	2534	`}`
		2535
		2536
6	7u83	2537	`exp`
		2538	`f_env_offset(alignment fa, alignment y, tag t)`
2	7u83	2539	`{`
6	7u83	2540	`exp e = get_tag(t);`
		2541	`shape s = f_offset(fa, y);`
		2542	`exp res;`
		2543	`if (e == nilexp) {`
		2544	`e = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0, 0,`
		2545	`ident_tag);`
		2546	`son(e) = e; /* used to indicate that tag is not yet defined!?*/`
		2547	`set_tag(t, e);`
		2548	`}`
		2549	`res = getexp(s, nilexp, 0, e, nilexp, 0, 0, env_offset_tag);`
		2550	`setvis(e);`
		2551	`setenvoff(e);`
		2552	`return res;`
2	7u83	2553	`}`
		2554
		2555
6	7u83	2556	`exp`
		2557	`f_fail_installer(string message)`
2	7u83	2558	`{`
6	7u83	2559	`char m = (char )xcalloc(message.number + 1, sizeof(char));`
		2560	`int i;`
		2561	`for (i=0; i<message.number; ++i) {`
		2562	`m[i] = message.ints.chars[i];`
		2563	`}`
		2564	`m[message.number] = 0;`
		2565	`failer(m);`
		2566	`exit(EXIT_FAILURE);`
		2567	`return (nilexp);`
2	7u83	2568	`}`
		2569
		2570
6	7u83	2571	`exp`
		2572	`f_goto(label dest)`
2	7u83	2573	`{`
6	7u83	2574	`exp lab = get_lab(dest);`
		2575	`exp r = getexp(f_bottom, nilexp, 0, nilexp, lab, 0, 0, goto_tag);`
		2576	`++no(son(lab));`
		2577	`return r;`
2	7u83	2578	`}`
		2579
6	7u83	2580
		2581	`exp`
		2582	`f_goto_local_lv(exp arg1)`
2	7u83	2583	`{`
6	7u83	2584	`if (name(sh(arg1)) == bothd) {`
		2585	`return arg1;`
		2586	`}`
2	7u83	2587
		2588	`#if check_shape`
6	7u83	2589	`if (name(sh(arg1)) != ptrhd) {`
		2590	`failer(CHSH_GOLOCALLV);`
		2591	`}`
2	7u83	2592	`#endif`
		2593
6	7u83	2594	`return me_u3(f_bottom, arg1, goto_lv_tag);`
2	7u83	2595	`}`
		2596
6	7u83	2597
		2598	`exp`
		2599	`f_identify(access_option acc, tag name_intro, exp definition, exp body)`
2	7u83	2600	`{`
6	7u83	2601	`exp i = get_tag(name_intro);`
		2602	`exp d = son(i);`
		2603	`UNUSED(acc);`
		2604	`if (name(sh(definition)) == bothd) {`
		2605	`kill_exp(body, body);`
		2606	`return definition;`
		2607	`}`
		2608	`setsh(i, sh(body));`
		2609	`setbro(d, body);`
		2610	`clearlast(d);`
		2611	`setfather(i, body);`
		2612	`return i;`
2	7u83	2613	`}`
		2614
6	7u83	2615
		2616	`void`
		2617	`start_identify(access_option acc, tag name_intro, exp definition)`
2	7u83	2618	`{`
6	7u83	2619	`exp i = get_tag(name_intro);`
		2620	`if (i == nilexp \|\| son(i) != i) {`
		2621	`i = getexp(f_bottom, nilexp, 0, definition, nilexp, 0, 0,`
		2622	`ident_tag);`
		2623	`} else {`
		2624	`/* could have been already used in env_offset */`
		2625	`son(i) = definition;`
		2626	`}`
		2627	`clearvar(i);`
		2628	`if ((acc & (f_visible \| f_long_jump_access)) != 0) {`
		2629	`setvis(i);`
		2630	`}`
		2631	`set_tag(name_intro, i);`
2	7u83	2632
6	7u83	2633	`return;`
2	7u83	2634	`}`
		2635
6	7u83	2636
		2637	`exp`
		2638	`f_ignorable(exp arg1)`
2	7u83	2639	`{`
6	7u83	2640	`if (name(sh(arg1)) == bothd) {`
		2641	`return arg1;`
		2642	`}`
		2643	`return me_u2(arg1, ignorable_tag);`
2	7u83	2644	`}`
		2645
		2646
6	7u83	2647	`exp`
		2648	`f_integer_test(nat_option prob, ntest nt, label dest, exp arg1, exp arg2)`
2	7u83	2649	`{`
6	7u83	2650	`if (name(sh(arg1)) == bothd) {`
		2651	`kill_exp(arg2, arg2);`
		2652	`return arg1;`
		2653	`}`
		2654	`if (name(sh(arg2)) == bothd) {`
		2655	`kill_exp(arg1, arg1);`
		2656	`return arg2;`
		2657	`}`
2	7u83	2658
		2659	`#if check_shape`
6	7u83	2660	`if (!is_integer(sh(arg1)) \|\| !eq_shape(sh(arg1), sh(arg2))) {`
		2661	`failer(CHSH_INTTEST);`
		2662	`}`
2	7u83	2663	`#endif`
		2664	`#if !has64bits`
		2665	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	2666	`(name(arg1) != val_tag \|\| name(arg2) != val_tag)) {`
2	7u83	2667	`error_treatment ov_err;`
		2668	`ov_err = f_wrap;`
6	7u83	2669	`arg1 = TDFcallop2(ov_err, arg1, arg2, test_tag);`
		2670	`arg2 = getexp(slongsh, nilexp, 0, nilexp, nilexp, 0, 0,`
		2671	`val_tag);`
2	7u83	2672	`}`
		2673	`#endif`
6	7u83	2674	`if (nt == f_comparable \|\| nt == f_not_comparable) {`
		2675	`return replace_ntest(nt, dest, arg1, arg2);`
		2676	`} else {`
		2677	`return me_q1(prob, convert_ntest[nt], dest, arg1, arg2,`
		2678	`test_tag);`
		2679	`}`
2	7u83	2680	`}`
		2681
6	7u83	2682
		2683	`exp`
		2684	`f_labelled(label_list placelabs_intro, exp starter, exp_list places)`
2	7u83	2685	`{`
6	7u83	2686	`exp f = places.start;`
		2687	`exp b;`
		2688	`int i;`
		2689	`clear_exp_list(places);`
2	7u83	2690
6	7u83	2691	`for (i = 0; i < places.number; ++i) {`
		2692	`exp labst = get_lab(placelabs_intro.elems[i]);`
		2693	`b = bro(f);`
2	7u83	2694
6	7u83	2695	`setbro(son(labst), f);`
		2696	`setbro(f, labst);`
		2697	`setlast(f);`
		2698	`setsh(labst, sh(f));`
		2699	`if (name(starter) == case_tag \|\|`
		2700	`(name(starter) == seq_tag &&`
		2701	`name(son(son(starter))) == case_tag)) {`
		2702	`fno(labst) = (float)(1.0 / places.number);`
		2703	`} else {`
		2704	`fno(labst) = (float)5.0;`
		2705	`}`
		2706	`f = b;`
		2707	`}`
		2708	`return (clean_labelled(starter, placelabs_intro));`
2	7u83	2709	`}`
		2710
6	7u83	2711
		2712	`void`
		2713	`start_labelled(label_list placelabs_intro)`
2	7u83	2714	`{`
6	7u83	2715	`UNUSED(placelabs_intro);`
		2716	`if (crt_repeat != nilexp) {`
		2717	`++no(crt_repeat);`
		2718	`}`
		2719	`repeat_list = getexp(f_top, crt_repeat, 0, nilexp, repeat_list, 0, 0,`
		2720	`0);`
		2721	`crt_repeat = repeat_list;`
2	7u83	2722
6	7u83	2723	`return;`
2	7u83	2724	`}`
		2725
6	7u83	2726
		2727	`exp`
		2728	`f_last_local(exp x)`
2	7u83	2729	`{`
6	7u83	2730	`UNUSED(x);`
		2731	`return getexp(f_pointer(f_alloca_alignment), nilexp, 0, nilexp, nilexp,`
		2732	`0, 0, last_local_tag);`
2	7u83	2733	`}`
		2734
6	7u83	2735
		2736	`exp`
		2737	`f_local_alloc(exp arg1)`
2	7u83	2738	`{`
6	7u83	2739	`alignment a;`
		2740	`if (name(sh(arg1)) == bothd) {`
		2741	`return arg1;`
		2742	`}`
2	7u83	2743
		2744	`#if check_shape`
6	7u83	2745	`if (name(sh(arg1)) != offsethd) {`
		2746	`failer(CHSH_LOCALLOC);`
		2747	`}`
2	7u83	2748	`#endif`
6	7u83	2749	`if (al2(sh(arg1)) < 8) {`
		2750	`arg1 = hold_check(f_offset_pad(f_alignment(ucharsh), arg1));`
		2751	`}`
		2752	`a = long_to_al(al1(sh(arg1)));`
		2753	`has_alloca = 1;`
		2754	`return me_u3(f_pointer(a), arg1, alloca_tag);`
2	7u83	2755	`}`
		2756
6	7u83	2757
		2758	`exp`
		2759	`f_local_alloc_check(exp arg1)`
2	7u83	2760	`{`
		2761	`exp res = f_local_alloc(arg1);`
6	7u83	2762	`if (name(res) ==alloca_tag) {`
2	7u83	2763	`set_checkalloc(res);`
		2764	`}`
		2765	`return res;`
		2766	`}`
		2767
6	7u83	2768
		2769	`exp`
		2770	`f_local_free(exp a, exp p)`
2	7u83	2771	`{`
6	7u83	2772	`if (name(sh(a)) == bothd) {`
		2773	`kill_exp(p, p);`
		2774	`return a;`
		2775	`}`
		2776	`if (name(sh(p)) == bothd) {`
		2777	`kill_exp(a, a);`
		2778	`return p;`
		2779	`}`
2	7u83	2780
		2781	`#if check_shape`
6	7u83	2782	`if (name(sh(a)) != offsethd \|\| name(sh(p)) != ptrhd) {`
		2783	`failer(CHSH_LOCFREE);`
		2784	`}`
2	7u83	2785	`#endif`
6	7u83	2786	`if (al2(sh(a)) <8) {`
		2787	`a = hold_check(f_offset_pad(f_alignment(ucharsh), a));`
		2788	`}`
2	7u83	2789
6	7u83	2790	`return me_b3(f_top, p, a, local_free_tag);`
2	7u83	2791	`}`
		2792
6	7u83	2793
		2794	`exp`
		2795	`f_local_free_all(void)`
2	7u83	2796	`{`
6	7u83	2797	`has_setjmp = 1; /* this really means dont inline`
		2798	`and use a stack frame */`
		2799	`return getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0,`
		2800	`local_free_all_tag);`
2	7u83	2801	`}`
		2802
		2803
6	7u83	2804	`exp`
		2805	`f_long_jump(exp arg1, exp arg2)`
2	7u83	2806	`{`
6	7u83	2807	`if (name(sh(arg1)) == bothd) {`
		2808	`kill_exp(arg2, arg2);`
		2809	`return arg1;`
		2810	`}`
		2811	`if (name(sh(arg2)) == bothd) {`
		2812	`kill_exp(arg1, arg1);`
		2813	`return arg2;`
		2814	`}`
2	7u83	2815
		2816	`#if check_shape`
6	7u83	2817	`if (name(sh(arg1)) != ptrhd \|\| name(sh(arg2)) != ptrhd) {`
		2818	`failer(CHSH_LONGJUMP);`
		2819	`}`
2	7u83	2820	`#endif`
		2821
6	7u83	2822	`has_setjmp = 1; /* this really means dont inline`
		2823	`and use a stack frame */`
		2824	`return me_b3(f_bottom, arg1, arg2, long_jump_tag);`
2	7u83	2825	`}`
		2826
6	7u83	2827
		2828	`static int`
		2829	`comp_compare(CONST void a, CONST void b)`
2	7u83	2830	`{`
6	7u83	2831	`return no(((exp )a)) - no(((exp )b));`
2	7u83	2832	`}`
		2833
		2834
6	7u83	2835	`exp`
		2836	`f_make_compound(exp arg1, exp_list arg2)`
2	7u83	2837	`{`
6	7u83	2838	`exp first = arg2.start;`
		2839	`exp r = getexp(f_compound(arg1), nilexp, 0, first, nilexp, 0, 0,`
		2840	`compound_tag);`
		2841	`clear_exp_list(arg2);`
2	7u83	2842
6	7u83	2843	`if (arg2.number == 0) {`
		2844	`setname(r, clear_tag);`
		2845	`return r;`
		2846	`}`
2	7u83	2847
		2848	`#if check_shape`
6	7u83	2849	`{`
		2850	`exp t = first;`
		2851	`while (1) {`
		2852	`if (t != arg2.end && name(sh(bro(t))) == bothd) {`
		2853	`return bro(t);`
		2854	`}`
		2855	`if (t == arg2.end \|\| name(sh(t)) != offsethd \|\|`
		2856	`(!doing_aldefs &&`
		2857	`al2(sh(t)) < shape_align(sh(bro(t))))) {`
		2858	`failer(CHSH_MAKECPD);`
		2859	`}`
		2860	`if (bro(t) == arg2.end) {`
		2861	`break;`
		2862	`}`
		2863	`t = bro(bro(t));`
		2864	`}`
		2865	`}`
2	7u83	2866	`#endif`
		2867
6	7u83	2868	`setfather(r, arg2.end);`
2	7u83	2869
6	7u83	2870	`if (!doing_aldefs && arg2.number > 2) {`
		2871	`exp arr = (exp )xcalloc(arg2.number, sizeof(exp));`
		2872	`int i;`
		2873	`exp t = son(r);`
2	7u83	2874
6	7u83	2875	`for (i = 0; i < arg2.number; ++i) {`
		2876	`if (!(i & 1) && (no(t) + shape_size(sh(bro(t))) >`
		2877	`shape_size(sh(r)))) {`
		2878	`failer("make_compound size exceeded");`
		2879	`}`
		2880	`arr[i] = t;`
		2881	`t = bro(t);`
		2882	`}`
2	7u83	2883
		2884	`#ifdef promote_pars`
6	7u83	2885	`for (i = 0; i < arg2.number; i += 2) {`
		2886	`alignment a = al2_of(sh(arr[i]));`
		2887	`if (a->al.sh_hd != 0) {`
		2888	`shape s = sh(arr[i + 1]);`
		2889	`if (name(s) >= scharhd && name(s) <= uwordhd) {`
		2890	`shape ns = (is_signed(s)) ? slongsh :`
		2891	`ulongsh;`
		2892	`exp w = hold_check(f_change_variety(`
		2893	`f_wrap, ns, arr[i + 1]));`
		2894	`arr[i+1] = w;`
		2895	`}`
		2896	`}`
2	7u83	2897	`}`
		2898	`#endif`
		2899
6	7u83	2900	`qsort(arr, (size_t)(arg2.number / 2), (size_t)(2 * sizeof(exp)),`
		2901	`comp_compare);`
2	7u83	2902
6	7u83	2903	`son(r) = arr[0];`
		2904	`for (i = 1; i < arg2.number; ++i) {`
		2905	`bro(arr[i - 1]) = arr[i];`
		2906	`clearlast(arr[i - 1]);`
		2907	`}`
		2908	`bro(arr[arg2.number - 1]) = r;`
		2909	`setlast(arr[arg2.number - 1]);`
2	7u83	2910
6	7u83	2911	`xfree((void *)arr);`
		2912	`}`
2	7u83	2913
6	7u83	2914	`return r;`
2	7u83	2915	`}`
		2916
		2917
6	7u83	2918	`exp`
		2919	`f_make_int(variety v, signed_nat value)`
2	7u83	2920	`{`
6	7u83	2921	`int n;`
2	7u83	2922
6	7u83	2923	`if (!snat_issmall(value) \|\|`
		2924	`(n = snatint(value), shape_size(v) > 32 &&`
		2925	`(n & (int)0x80000000) != 0)) {`
		2926	`flpt b;`
		2927	`exp res;`
2	7u83	2928
6	7u83	2929	`if (shape_size(v) <= 32) {`
		2930	`if (!extra_checks) {`
		2931	`flt64 temp;`
		2932	`int ov;`
		2933	`temp = flt_to_f64(`
		2934	`value.signed_nat_val.big_s_nat, 0, &ov);`
		2935	`n = temp.small;`
		2936	`res = getexp(f_integer(v), nilexp, 0, nilexp,`
		2937	`nilexp, 0, n, val_tag);`
		2938	`return res;`
		2939	`} else {`
		2940	`failer(BIG_32);`
		2941	`exit(EXIT_FAILURE);`
		2942	`}`
		2943	`}`
		2944	`if (snat_issmall(value)) {`
		2945	`flt64 temp;`
		2946	`temp.big = 0;`
		2947	`temp.small = (unsigned int)n;`
		2948	`b = f64_to_flt(temp, 0);`
		2949	`} else {`
		2950	`/* copy required since exp may be killed & value may be`
		2951	`token res */`
		2952	`b = new_flpt();`
		2953	`flt_copy(flptnos[value.signed_nat_val.big_s_nat],`
		2954	`&flptnos[b]);`
		2955	`}`
		2956	`if (snatneg(value)) {`
		2957	`flptnos[b].sign = -1;`
		2958	`}`
		2959
		2960	`if (flptnos[b].exp > 3) {`
		2961	`failer(BIG_32);`
		2962	`exit(EXIT_FAILURE);`
		2963	`}`
		2964	`res = getexp(f_integer(v), nilexp, 0, nilexp, nilexp, 0, b,`
		2965	`val_tag);`
		2966	`setbigval(res);`
2	7u83	2967	`return res;`
6	7u83	2968	`} else {`
		2969	`if (snatneg(value)) {`
		2970	`n = -n;`
		2971	`}`
		2972
		2973	`return getexp(f_integer(v), nilexp, 0, nilexp, nilexp, 0, n,`
		2974	`val_tag);`
2	7u83	2975	`}`
6	7u83	2976	`}`
2	7u83	2977
		2978
6	7u83	2979	`exp`
		2980	`f_make_local_lv(label lab)`
2	7u83	2981	`{`
6	7u83	2982	`exp l = get_lab(lab);`
		2983	`exp res = getexp(f_local_label_value, nilexp, 0, nilexp, l, 0, 0,`
		2984	`make_lv_tag);`
		2985	`++no(son(l));`
		2986	`set_loaded_lv(l);`
		2987	`has_lv = 1;`
		2988	`return res;`
2	7u83	2989	`}`
		2990
6	7u83	2991
		2992	`exp`
		2993	`f_make_nof(exp_list arg1)`
2	7u83	2994	`{`
6	7u83	2995	`exp first = arg1.start;`
		2996	`nat t;`
		2997	`exp r;`
		2998	`clear_exp_list(arg1);`
		2999	`nat_issmall(t) = 1;`
		3000	`natint(t) = arg1.number;`
		3001	`if (arg1.number == 0) {`
		3002	`return getexp(f_nof(t, f_top), nilexp, 0, nilexp, nilexp, 0, 0,`
		3003	`nof_tag);`
		3004	`}`
		3005	`r = getexp(f_nof(t, sh(first)), nilexp, 0, first, nilexp, 0, 0,`
		3006	`nof_tag);`
2	7u83	3007
		3008	`#if check_shape`
6	7u83	3009	`{`
		3010	`exp temp = first;`
		3011	`while (1) {`
		3012	`if (!eq_shape(sh(temp), sh(first))) {`
		3013	`failer(CHSH_MAKENOF);`
		3014	`}`
		3015	`if (temp == arg1.end) {`
		3016	`break;`
		3017	`}`
		3018	`temp = bro(temp);`
		3019	`}`
		3020	`}`
2	7u83	3021	`#endif`
		3022
6	7u83	3023	`if (name(sh(first)) == bitfhd) {`
		3024	`/* make make_nof bitbields into make-compound */`
		3025	`int sf = shape_size(sh(first));`
		3026	`int snof = shape_size(sh(r));`
		3027	`exp *a = &arg1.start;`
		3028	`int scs = (((sf - 1) &sf) == 0) ? sf : snof;`
		3029	`shape cs = containedshape(scs, 1);`
		3030	`int i;`
		3031	`shape cpds = f_compound(hold_check(f_offset_pad(f_alignment(cs),`
		3032	`f_shape_offset(sh(r)))));`
		3033	`exp soff = getexp(f_offset(f_alignment(cpds),`
		3034	`f_alignment(sh(first))),`
		3035	`nilexp, 0, nilexp, nilexp, 0, 0, val_tag);`
		3036	`for (i = 0; i < arg1.number; i++) {`
		3037	`bro(soff) = *a;`
		3038	`*a = copyexp(soff);`
		3039	`a = &bro(bro(*a));`
		3040	`no(soff) += sf;`
		3041	`}`
		3042	`arg1.number *= 2;`
		3043	`return f_make_compound(hold_check(f_shape_offset(cpds)), arg1);`
2	7u83	3044	`}`
		3045
6	7u83	3046	`setfather(r, arg1.end);`
		3047	`return r;`
2	7u83	3048	`}`
		3049
6	7u83	3050
		3051	`exp`
		3052	`f_make_nof_int(variety v, string s)`
2	7u83	3053	`{`
6	7u83	3054	`shape sha;`
		3055	`exp res;`
		3056	`nat t;`
		3057	`int i;`
		3058	`shape elem_sh = f_integer(v);`
		3059	`int elem_sz = shape_size(elem_sh);`
2	7u83	3060
6	7u83	3061	`if (PIC_code) {`
		3062	`proc_externs = 1;`
		3063	`}`
2	7u83	3064
6	7u83	3065	`nat_issmall(t) = 1;`
		3066	`natint(t) = s.number;`
		3067	`sha = f_nof(t, elem_sh);`
		3068	`res = getexp(sha, nilexp, 0, nilexp, nilexp, (prop)elem_sz, 0,`
		3069	`string_tag);`
2	7u83	3070
		3071
6	7u83	3072	`if (elem_sz == 64) {`
		3073	`int ss = (int )xcalloc(s.number, sizeof(int));`
		3074	`for (i = 0; i < s.number; ++i) {`
		3075	`flt64 x;`
		3076	`flpt f;`
		3077	`int ov;`
		3078	`int sg = is_signed(elem_sh);`
		3079	`x.big = 0;`
		3080	`switch (s.size) {`
		3081	`case 8:`
		3082	`x.small = (unsigned int)s.ints.chars[i];`
		3083	`break;`
		3084	`case 16:`
		3085	`x.small = (unsigned int)s.ints.shorts[i];`
		3086	`break;`
		3087	`case 32:`
		3088	`x.small = (unsigned int)s.ints.longs[i];`
		3089	`break;`
		3090	`default:`
		3091	`f = (flpt)s.ints.longs[i];`
		3092	`x = flt_to_f64(f, 0, &ov);`
		3093	`flpt_ret(f);`
		3094	`if (s.size < 64 && sg) {`
		3095	`x.big = (x.big << (64 - s.size)) >>`
		3096	`(64 - s.size);`
		3097	`}`
		3098	`}`
		3099	`ss[i] = f64_to_flt(x, sg);`
		3100	`}`
		3101	`nostr(res) = (char )(void )ss;`
		3102	`return res;`
		3103	`}`
		3104
2	7u83	3105	`switch (s.size) {`
6	7u83	3106	`case 8:`
		3107	`switch (elem_sz) {`
		3108	`case 8:`
		3109	`nostr(res) = (char *)s.ints.chars;`
		3110	`return res;`
		3111	`case 16: {`
		3112	`short ss = (short )xcalloc(s.number, sizeof(short));`
		3113	`for (i = 0; i < s.number; ++i) {`
		3114	`ss[i] = (short)(unsigned char)s.ints.chars[i];`
		3115	`}`
		3116	`nostr(res) = (char )(void )ss;`
		3117	`return res;`
		3118	`}`
		3119	`case 32: {`
		3120	`int ss = (int )xcalloc(s.number, sizeof(int));`
		3121	`for (i = 0; i < s.number; ++i) {`
		3122	`ss[i] = (int)(unsigned char)s.ints.chars[i];`
		3123	`}`
		3124	`nostr(res) = (char )(void )ss;`
		3125	`return res;`
		3126	`}`
		3127	`}`
		3128	`case 16:`
		3129	`switch (elem_sz) {`
		3130	`case 8: {`
		3131	`char ss = (char )xcalloc(s.number, sizeof(char));`
		3132	`for (i = 0; i < s.number; ++i) {`
		3133	`ss[i] = (char)(unsigned short)s.ints.shorts[i];`
		3134	`}`
		3135	`nostr(res) = (char )(void )ss;`
		3136	`return res;`
		3137	`}`
		3138	`case 16:`
		3139	`nostr(res) = (char )(void )s.ints.shorts;`
		3140	`return res;`
		3141	`case 32: {`
		3142	`int ss = (int )xcalloc(s.number, sizeof(int));`
		3143	`for (i = 0; i < s.number; ++i) {`
		3144	`ss[i] = (int)(unsigned short)s.ints.shorts[i];`
		3145	`}`
		3146	`nostr(res) = (char )(void )ss;`
		3147	`return res;`
		3148	`}`
		3149	`}`
		3150	`case 32:`
		3151	`switch (elem_sz) {`
		3152	`case 8: {`
		3153	`char ss = (char )xcalloc(s.number, sizeof(char));`
		3154	`for (i = 0; i < s.number; ++i) {`
		3155	`ss[i] = (char)(unsigned long)s.ints.longs[i];`
		3156	`}`
		3157	`nostr(res) = (char )(void )ss;`
		3158	`return res;`
		3159	`}`
		3160	`case 16: {`
		3161	`short ss = (short )xcalloc(s.number, sizeof(short));`
		3162	`for (i = 0; i < s.number; ++i) {`
		3163	`ss[i] = (short)(unsigned long)s.ints.longs[i];`
		3164	`}`
		3165	`nostr(res) = (char )(void )ss;`
		3166	`return res;`
		3167	`}`
		3168	`case 32:`
		3169	`nostr(res) = (char )(void )s.ints.longs;`
		3170	`return res;`
		3171	`}`
		3172	`}`
		3173	`return res;`
2	7u83	3174	`}`
		3175
6	7u83	3176
		3177	`exp`
		3178	`f_make_null_local_lv(void)`
2	7u83	3179	`{`
6	7u83	3180	`return me_null(f_local_label_value, lv_null, null_tag);`
2	7u83	3181	`}`
		3182
6	7u83	3183
		3184	`exp`
		3185	`f_make_null_proc(void)`
2	7u83	3186	`{`
6	7u83	3187	`return me_null(f_proc, proc_null, null_tag);`
2	7u83	3188	`}`
		3189
6	7u83	3190
		3191	`exp`
		3192	`f_make_null_ptr(alignment a)`
2	7u83	3193	`{`
6	7u83	3194	`return me_null(f_pointer(a), ptr_null, null_tag);`
2	7u83	3195	`}`
		3196
6	7u83	3197	`exp`
		3198	`f_maximum(exp arg1, exp arg2)`
2	7u83	3199	`{`
6	7u83	3200	`if (name(sh(arg1)) == bothd) {`
		3201	`kill_exp(arg2, arg2);`
		3202	`return arg1;`
		3203	`}`
		3204	`if (name(sh(arg2)) == bothd) {`
		3205	`kill_exp(arg1, arg1);`
		3206	`return arg2;`
		3207	`}`
2	7u83	3208
		3209	`#if check_shape`
6	7u83	3210	`if (!eq_shape(sh(arg1), sh(arg2)) \|\| !is_integer(sh(arg1))) {`
		3211	`failer(CHSH_MAX);`
		3212	`}`
2	7u83	3213	`#endif`
		3214	`#if !has64bits`
		3215	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	3216	`(name(arg1) != val_tag \|\| name(arg2) != val_tag)) {`
		3217	`return TDFcallop3(arg1, arg2, max_tag);`
2	7u83	3218	`}`
		3219	`#endif`
6	7u83	3220	`return me_b2(arg1, arg2, max_tag);`
2	7u83	3221	`}`
		3222
6	7u83	3223	`exp`
		3224	`f_minimum(exp arg1, exp arg2)`
2	7u83	3225	`{`
6	7u83	3226	`if (name(sh(arg1)) == bothd) {`
		3227	`kill_exp(arg2, arg2);`
		3228	`return arg1;`
		3229	`}`
		3230	`if (name(sh(arg2)) == bothd) {`
		3231	`kill_exp(arg1, arg1);`
		3232	`return arg2;`
		3233	`}`
2	7u83	3234	`#if check_shape`
6	7u83	3235	`if (!eq_shape(sh(arg1), sh(arg2)) \|\| !is_integer(sh(arg1))) {`
		3236	`failer(CHSH_MIN);`
		3237	`}`
2	7u83	3238	`#endif`
		3239	`#if !has64bits`
		3240	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	3241	`(name(arg1) != val_tag \|\| name(arg2) != val_tag)) {`
2	7u83	3242	`error_treatment ov_err;`
		3243	`ov_err = f_wrap;`
6	7u83	3244	`return TDFcallop2(ov_err, arg1, arg2, min_tag);`
2	7u83	3245	`}`
		3246	`#endif`
		3247
6	7u83	3248	`return me_b2(arg1, arg2, min_tag);`
2	7u83	3249	`}`
		3250
6	7u83	3251
2	7u83	3252	`static int in_initial_value;`
		3253
6	7u83	3254	`static void`
		3255	`push_proc_props(void)`
2	7u83	3256	`{`
6	7u83	3257	`proc_props temp = (proc_props )xcalloc(1, sizeof(proc_props));`
		3258	`temp->proc_struct_result = proc_struct_result;`
		3259	`temp->has_alloca = has_alloca;`
		3260	`temp->proc_is_recursive = proc_is_recursive;`
		3261	`temp->uses_crt_env = uses_crt_env;`
		3262	`temp->has_setjmp = has_setjmp;`
		3263	`temp->uses_loc_address = uses_loc_address;`
		3264	`temp->proc_label_count = proc_label_count;`
		3265	`temp->proc_struct_res = proc_struct_res;`
		3266	`temp->default_freq = default_freq;`
		3267	`temp->proc_externs = proc_externs;`
		3268	`temp->in_proc_def = in_proc_def;`
		3269	`temp->pushed = old_proc_props;`
		3270	`temp->rep_make_proc = rep_make_proc;`
		3271	`temp->frame_alignment = frame_alignment;`
		3272	`temp->in_initial_value = in_initial_value;`
		3273	`old_proc_props = temp;`
		3274	`return;`
2	7u83	3275	`}`
		3276
6	7u83	3277
		3278	`static void`
		3279	`pop_proc_props(void)`
2	7u83	3280	`{`
6	7u83	3281	`proc_props *temp = old_proc_props;`
		3282	`proc_struct_result = temp->proc_struct_result;`
		3283	`has_alloca = temp->has_alloca;`
		3284	`proc_is_recursive =temp->proc_is_recursive;`
		3285	`uses_crt_env = temp->uses_crt_env;`
		3286	`has_setjmp = temp->has_setjmp;`
		3287	`uses_loc_address = temp->uses_loc_address;`
		3288	`proc_label_count = temp->proc_label_count;`
		3289	`proc_struct_res = temp->proc_struct_res;`
		3290	`default_freq = temp->default_freq;`
		3291	`proc_externs = temp->proc_externs;`
		3292	`in_proc_def = temp->in_proc_def;`
		3293	`old_proc_props = temp->pushed;`
		3294	`rep_make_proc = temp->rep_make_proc;`
		3295	`frame_alignment = temp->frame_alignment;`
		3296	`in_initial_value = temp->in_initial_value;`
		3297	`if (temp != &initial_value_pp) {`
		3298	`xfree((void *)temp);`
		3299	`}`
		3300	`return;`
2	7u83	3301	`}`
		3302
6	7u83	3303
		3304	`void`
		3305	`start_make_proc(shape result_shape, tagshacc_list params_intro,`
		3306	`tagacc_option vartag)`
2	7u83	3307	`{`
6	7u83	3308	`/* initialise global flags which are used at the end of the`
		3309	`reading process in f_make_proc */`
		3310	`UNUSED(result_shape); UNUSED(params_intro);`
		3311	`push_proc_props();`
2	7u83	3312
6	7u83	3313	`proc_struct_result = nilexp;`
		3314	`has_alloca = 0;`
		3315	`proc_is_recursive = 0;`
		3316	`uses_crt_env = 0;`
		3317	`has_setjmp = 0;`
		3318	`uses_loc_address = 0;`
		3319	`proc_label_count = 0;`
		3320	`proc_struct_res = 0;`
		3321	`default_freq = 1.0;`
		3322	`proc_externs = 0;`
		3323	`in_initial_value = 0;`
		3324	`frame_alignment = f_unite_alignments(f_locals_alignment,`
		3325	`var_callers_alignment);`
2	7u83	3326
6	7u83	3327	`if (vartag.present) {`
		3328	`shape sha = getshape(0, const_al1, const_al1, VAR_PARAM_ALIGN,`
		3329	`0, cpdhd);`
		3330	`exp d = getexp(sha, nilexp, 0, nilexp, nilexp, 0, 0, clear_tag);`
		3331	`exp i = getexp(f_bottom, nilexp, 1, d, nilexp, 0, 0, ident_tag);`
		3332	`setvis(i);`
		3333	`setvar(i);`
		3334	`setparam(i);`
		3335	`set_tag(vartag.val.tg, i);`
		3336	`}`
2	7u83	3337
6	7u83	3338	`/* set this flag to distinguish values created during procedure`
		3339	`reading. */`
		3340	`in_proc_def = 1;`
2	7u83	3341
6	7u83	3342	`return;`
2	7u83	3343	`}`
		3344
6	7u83	3345
		3346	`exp`
		3347	`f_make_proc(shape result_shape, tagshacc_list params_intro,`
		3348	`tagacc_option vartag, exp body)`
2	7u83	3349	`{`
6	7u83	3350	`exp res;`
		3351	`int varhack = 0;`
2	7u83	3352	`#if ishppa`
6	7u83	3353	`exp t, id, ptr;`
2	7u83	3354	`#endif`
		3355
		3356	`#if check_shape`
6	7u83	3357	`if (name(sh(body)) != bothd) {`
		3358	`failer(CHSH_MAKE_PROC);`
		3359	`}`
2	7u83	3360	`#endif`
		3361
6	7u83	3362	`if (vartag.present) {`
		3363	`exp i = get_tag(vartag.val.tg);`
		3364	`if (params_intro.id == nilexp) {`
		3365	`params_intro.id = i;`
		3366	`} else {`
		3367	`bro(params_intro.last_def) = i;`
		3368	`}`
		3369	`bro(i) = params_intro.last_id;`
		3370	`params_intro.last_def = son(i);`
		3371	`params_intro.last_id = i;`
		3372	`setvis(i);`
		3373	`++params_intro.number;`
		3374	`varhack = 1;`
		3375	`}`
2	7u83	3376
6	7u83	3377	`res = getexp(f_proc, nilexp, 0, params_intro.id, result_shape, 0, 0,`
		3378	`proc_tag);`
2	7u83	3379
6	7u83	3380	`if (params_intro.number == 0) {`
		3381	`son(res) = body;`
		3382	`setlast(body);`
		3383	`bro(body) = res;`
		3384	`} else {`
		3385	`bro(son(res)) = res;`
		3386	`bro(params_intro.last_def) = body;`
		3387	`setlast(body);`
		3388	`bro(body) = params_intro.last_id;`
2	7u83	3389	`#ifdef promote_pars`
6	7u83	3390	`promote_formals(son(res));`
2	7u83	3391	`#endif`
6	7u83	3392	`}`
2	7u83	3393
6	7u83	3394	`/* set the properties of the procedure construction from the`
		3395	`global values accumulated during reading.`
		3396	`WE OUGHT TO POP THE OLD VALUES.`
		3397	`*/`
		3398	`if (has_alloca) {`
		3399	`set_proc_has_alloca(res);`
		3400	`}`
		3401	`if (proc_is_recursive) {`
		3402	`setrecursive(res);`
		3403	`}`
		3404	`if (has_lv) {`
		3405	`set_proc_has_lv(res);`
		3406	`}`
		3407	`if (uses_crt_env) {`
		3408	`set_proc_uses_crt_env(res);`
		3409	`}`
		3410	`if (has_setjmp) {`
		3411	`set_proc_has_setjmp(res);`
		3412	`}`
		3413	`if (uses_loc_address) {`
		3414	`set_loc_address(res);`
		3415	`}`
		3416	`if (proc_struct_res) {`
		3417	`set_struct_res(res);`
		3418	`}`
		3419	`if (proc_externs) {`
		3420	`set_proc_uses_external(res);`
		3421	`}`
2	7u83	3422
6	7u83	3423	`/* apply check_id to the parameters */`
2	7u83	3424
6	7u83	3425	`if (params_intro.number != 0) {`
		3426	`exp param;`
		3427	`for (param = params_intro.last_id; param != res;`
		3428	`param = bro(param)) {`
		3429	`if (redo_structparams &&`
2	7u83	3430	`#if ishppa`
6	7u83	3431	`(varhack \|\| ((shape_size(sh(son(param))) >64) &&`
		3432	`(name(sh(son(param))) == cpdhd \|\|`
		3433	`name(sh(son(param))) == nofhd \|\|`
		3434	`name(sh(son(param))) == doublehd))))`
2	7u83	3435	`#else`
		3436	`#if issparc`
6	7u83	3437	`(varhack \|\| sparccpd(sh(son(param)))))`
2	7u83	3438
		3439	`#else`
6	7u83	3440	`(varhack \|\| name(sh(son(param))) == cpdhd \|\|`
		3441	`name(sh(son(param))) == nofhd \|\|`
		3442	`name(sh(son(param))) == doublehd))`
2	7u83	3443	`#endif`
		3444	`#endif`
6	7u83	3445	`{`
		3446	`/*`
		3447	`* Param IS struct/union-by-value. Incoming`
		3448	`* acutal parameter will have been changed to`
		3449	`* be ptr-to expected value (see`
		3450	`* f_apply_proc()), so adjust usage in body.`
		3451	`*/`
		3452	`exp use; /* use of ident in pt() chain */`
		3453	`exp prev; /* previous use in pt() chain */`
		3454	`exp eo = nilexp;`
		3455	`shape ptr_s =`
		3456	`f_pointer(f_alignment(sh(son(param))));`
2	7u83	3457
		3458	`#if ishppa`
6	7u83	3459	`/* modify parameter itself */`
		3460	`if (!varhack) {`
		3461	`exp obtain_param;`
		3462	`exp assign;`
		3463	`shape sha=sh(son(param));`
		3464	`t=me_obtain(param);`
		3465	`if (uses_crt_env) {`
		3466	`eo = f_env_offset(`
		3467	`frame_alignment,`
		3468	`f_parameter_alignment(`
		3469	`ptr_s), brog(param));`
		3470	`obtain_param =`
		3471	`f_add_to_ptr(`
		3472	`f_current_env(), eo);`
		3473	`}`
		3474	`id = me_startid(f_top,`
		3475	`me_u3(sha, t, cont_tag),`
		3476	`1);`
		3477	`ptr = me_startid(f_top, me_obtain(id),`
		3478	`0);`
		3479	`if (uses_crt_env) {`
		3480	`assign =`
		3481	`f_assign(obtain_param,`
		3482	`me_obtain(id));`
		3483	`body = f_sequence(add_exp_list(`
		3484	`new_exp_list(1), assign,`
		3485	`0), body);`
		3486	`}`
		3487	`clearlast(son(ptr));`
		3488	`bro(son(ptr)) = body;`
		3489	`setlast(body);`
		3490	`bro(body) = ptr;`
		3491	`sh(ptr) = sh(body);`
		3492	`body = id;`
		3493	`clearlast(son(id));`
		3494	`bro(son(id)) = ptr;`
		3495	`setlast(ptr);`
		3496	`bro(ptr) = id;`
		3497	`sh(id) = sh(ptr);`
		3498	`bro(params_intro.last_def) = body;`
		3499	`setlast(body);`
		3500	`bro(body) = param;`
		3501	`}`
2	7u83	3502	`#endif`
		3503
6	7u83	3504	`/* visit each use of the parameter modifying`
		3505	`appropriately*/`
		3506	`for (prev = param, use = pt(prev);`
		3507	`use != nilexp;`
		3508	`prev = use, use = pt(prev)) {`
		3509	`if (!uses_crt_env \|\|`
		3510	`(uses_crt_env && use != eo)) {`
		3511	`if (!isvar(param)) {`
		3512	`/* add cont */`
		3513	`exp new_use =`
		3514	`getexp(ptr_s, use,`
		3515	`(bool)1,`
		3516	`son(use),`
		3517	`pt(use),`
		3518	`props(use),`
		3519	`0, name_tag);`
		3520	`son(use) = new_use;`
		3521	`pt(prev) = new_use;`
		3522	`pt(use) = nilexp;`
		3523	`props(use) = (prop)0;`
		3524	`setname(use, cont_tag);`
		3525	`/* retain same no and`
		3526	`sh */`
2	7u83	3527
6	7u83	3528	`use = new_use;`
		3529	`}`
2	7u83	3530
6	7u83	3531	`if (no(use) > 0) {`
		3532	`/* add reff */`
		3533	`exp new_use =`
		3534	`getexp(ptr_s, use,`
		3535	`(bool)1,`
		3536	`son(use),`
		3537	`pt(use),`
		3538	`props(use),`
		3539	`0, name_tag);`
		3540	`son(use) = new_use;`
		3541	`pt(prev) = new_use;`
		3542	`pt(use) = nilexp;`
		3543	`props(use) = (prop)0;`
		3544	`setname(use, reff_tag);`
		3545	`/* retain same no and`
		3546	`sh */`
2	7u83	3547
6	7u83	3548	`use = new_use;`
		3549	`}`
		3550	`}`
		3551	`} /* for */`
2	7u83	3552
		3553	`#if ishppa`
6	7u83	3554	`if (!varhack) {`
		3555	`/* Change all but ptr's references to`
		3556	`param to references to ptr */`
		3557	`for (use = pt(param); use != nilexp;`
		3558	`use = pt(use)) {`
		3559	`if ((son(use) ==param) &&`
		3560	`(use != son(son(id))) &&`
		3561	`(!uses_crt_env \|\|`
		3562	`(uses_crt_env &&`
		3563	`use != eo))) {`
		3564	`son(use) =ptr;`
		3565	`}`
		3566	`}`
		3567	`pt(ptr) =pt(param);`
		3568	`}`
2	7u83	3569	`#endif`
		3570
6	7u83	3571	`/* modify parameter itself */`
		3572	`if (isenvoff(param)) {`
		3573	`props(param) = (prop)0;`
		3574	`setvis(param);`
		3575	`} else {`
		3576	`props(param) = (prop)0;`
		3577	`}`
		3578	`setparam(param);`
		3579	`setcaonly(param);`
		3580	`if (varhack) {`
		3581	`setvis(param);`
		3582	`}`
		3583	`setsh(son(param), ptr_s);`
		3584	`} /* if redo... */`
		3585	`varhack = 0;`
		3586	`/* apply check_id to the parameters */`
		3587	`IGNORE check_id(param, param);`
		3588	`} /* for */`
2	7u83	3589	`}`
		3590
6	7u83	3591	`if (proc_struct_result != nilexp) {`
		3592	`bro(son(proc_struct_result)) = son(res);`
		3593	`setfather(proc_struct_result, son(res));`
		3594	`son(res) = proc_struct_result;`
		3595	`setfather(res, proc_struct_result);`
		3596	`}`
2	7u83	3597
6	7u83	3598	`/* clear this flag to distinguish values created during procedure`
		3599	`reading. */`
		3600	`in_proc_def = 0;`
2	7u83	3601
6	7u83	3602	`pop_proc_props();`
2	7u83	3603
6	7u83	3604	`if (old_proc_props != (proc_props *)0 \|\| rep_make_proc) {`
		3605	`dec *extra_dec = make_extra_dec(make_local_name(), 0, 0, res,`
		3606	`f_proc);`
		3607	`exp e = extra_dec->dec_u.dec_val.dec_exp;`
		3608	`res = getexp(f_proc, nilexp, 0, e, nilexp, 0, 0, name_tag);`
		3609	`pt(e) = res;`
		3610	`no(e) = 1;`
		3611	`}`
2	7u83	3612
6	7u83	3613	`return res;`
2	7u83	3614	`}`
		3615
6	7u83	3616
2	7u83	3617	`procprops crt_procprops;`
		3618
		3619	`void`
6	7u83	3620	`start_make_general_proc(shape result_shape, procprops prcprops,`
		3621	`tagshacc_list caller_intro, tagshacc_list callee_intro)`
2	7u83	3622	`{`
6	7u83	3623	`/* initialise global flags which are used at the end of the`
		3624	`reading process in f_make_proc */`
2	7u83	3625
6	7u83	3626	`push_proc_props();`
2	7u83	3627
6	7u83	3628	`proc_struct_result = nilexp;`
		3629	`has_alloca = 0;`
		3630	`proc_is_recursive = 0;`
		3631	`uses_crt_env = 0;`
		3632	`has_setjmp = 0;`
		3633	`uses_loc_address = 0;`
		3634	`proc_label_count = 0;`
		3635	`proc_struct_res = 0;`
		3636	`default_freq = 1.0;`
		3637	`frame_alignment = f_unite_alignments(f_locals_alignment,`
		3638	`f_callers_alignment((prcprops &`
		3639	`f_var_callers) != 0));`
		3640	`frame_alignment = f_unite_alignments(frame_alignment,`
		3641	`f_callees_alignment((prcprops &`
		3642	`f_var_callees) != 0));`
2	7u83	3643
6	7u83	3644	`proc_externs = 0;`
		3645	`/* set this flag to distinguish values created during procedure`
		3646	`reading. */`
		3647	`in_proc_def = 1;`
		3648	`crt_procprops = prcprops;`
		3649	`return;`
2	7u83	3650	`}`
		3651
6	7u83	3652
		3653	`exp`
		3654	`f_make_general_proc(shape result_shape, procprops prcprops,`
		3655	`tagshacc_list caller_intro, tagshacc_list callee_intro,`
		3656	`exp body)`
2	7u83	3657	`{`
6	7u83	3658	`exp res;`
2	7u83	3659	`#if check_shape`
6	7u83	3660	`if (name(sh(body)) != bothd) {`
		3661	`failer(CHSH_MAKE_PROC);`
		3662	`}`
2	7u83	3663	`#endif`
6	7u83	3664	`res = getexp(f_proc, nilexp, 0, caller_intro.id, result_shape, 0, 0,`
		3665	`general_proc_tag);`
2	7u83	3666
6	7u83	3667	`if (caller_intro.number == 0 && callee_intro.number == 0) {`
		3668	`son(res) = body;`
		3669	`setlast(body);`
		3670	`bro(body) = res;`
		3671	`} else if (callee_intro.number == 0) {`
		3672	`bro(son(res)) = res;`
		3673	`bro(caller_intro.last_def) = body;`
		3674	`setlast(body);`
		3675	`bro(body) = caller_intro.last_id;`
		3676	`} else {`
		3677	`int i;`
		3678	`exp z = callee_intro.id;`
		3679	`for (i = 0; i < callee_intro.number; i++) {`
		3680	`set_callee(z);`
		3681	`z = bro(son(z));`
		3682	`}`
		3683	`if (caller_intro.number != 0) {`
		3684	`bro(caller_intro.last_def) = callee_intro.id;`
		3685	`bro(callee_intro.id) = caller_intro.last_id; /???/`
		3686	`} else {`
		3687	`son(res) = callee_intro.id;`
		3688	`}`
		3689	`bro(son(res)) = res;`
		3690	`bro(callee_intro.last_def) = body;`
		3691	`setlast(body);`
		3692	`bro(body) = callee_intro.last_id;`
		3693	`}`
2	7u83	3694
		3695	`#ifdef promote_pars`
6	7u83	3696	`promote_formals(son(res));`
2	7u83	3697	`#endif`
6	7u83	3698	`/* set the properties of the procedure construction from the`
		3699	`global values accumulated during reading.`
		3700	`WE OUGHT TO POP THE OLD VALUES.`
		3701	`*/`
		3702	`if (has_alloca) {`
		3703	`set_proc_has_alloca(res);`
		3704	`}`
		3705	`if (proc_is_recursive) {`
		3706	`setrecursive(res);`
		3707	`}`
		3708	`if (has_lv) {`
		3709	`set_proc_has_lv(res);`
		3710	`}`
		3711	`if (uses_crt_env) {`
		3712	`set_proc_uses_crt_env(res);`
		3713	`}`
		3714	`if (has_setjmp) {`
		3715	`set_proc_has_setjmp(res);`
		3716	`}`
		3717	`if (uses_loc_address) {`
		3718	`set_loc_address(res);`
		3719	`}`
		3720	`if (proc_struct_res) {`
		3721	`set_struct_res(res);`
		3722	`}`
		3723	`if (proc_externs) {`
		3724	`set_proc_uses_external(res);`
		3725	`}`
2	7u83	3726
6	7u83	3727	`if (caller_intro.number != 0) {`
		3728	`bool varhack = 0;`
		3729	`exp param;`
		3730	`for (param = caller_intro.last_id; param != res;`
		3731	`param = bro(param)) {`
		3732	`if (redo_structparams && !varhack &&`
2	7u83	3733	`#if ishppa`
6	7u83	3734	`shape_size(sh(son(param))) > 64)`
2	7u83	3735	`#else`
6	7u83	3736	`(name(sh(son(param))) == cpdhd \|\|`
		3737	`name(sh(son(param))) == nofhd \|\|`
2	7u83	3738	`#if issparc`
6	7u83	3739	`sparccpd(sh(son(param))) \|\|`
2	7u83	3740	`#endif`
6	7u83	3741	`name(sh(son(param))) == doublehd))`
2	7u83	3742	`#endif`
6	7u83	3743	`{`
		3744	`/*`
		3745	`* Param IS struct/union-by-value. Incoming`
		3746	`* acutal parameter will have been changed to`
		3747	`* be ptr-to expected value (see`
		3748	`* f_apply_proc()), so adjust usage in body.`
		3749	`*/`
		3750	`exp use; /* use of ident in pt() chain */`
		3751	`exp prev; /* previous use in pt() chain */`
2	7u83	3752
6	7u83	3753	`shape ptr_s =`
		3754	`f_pointer(f_alignment(sh(son(param))));`
		3755	`int mustbevis;`
2	7u83	3756
6	7u83	3757	`/* visit each use of the parameter modifying`
		3758	`appropriately*/`
		3759	`for (prev = param, use = pt(prev);`
		3760	`use != nilexp;`
		3761	`prev = use, use = pt(prev)) {`
		3762	`if (!isvar(param)) {`
		3763	`/* add cont */`
		3764	`exp new_use =`
		3765	`getexp(ptr_s, use, (bool)1,`
		3766	`son(use), pt(use),`
		3767	`props(use), 0,`
		3768	`name_tag);`
		3769	`son(use) = new_use;`
		3770	`pt(prev) = new_use;`
		3771	`pt(use) = nilexp;`
		3772	`props(use) = (prop)0;`
		3773	`/* retain same no and sh */`
		3774	`setname(use, cont_tag);`
2	7u83	3775
6	7u83	3776	`use = new_use;`
		3777	`}`
2	7u83	3778
6	7u83	3779	`if (no(use) > 0) { /* add reff */`
		3780	`exp new_use =`
		3781	`getexp(ptr_s, use, (bool)1,`
		3782	`son(use), pt(use),`
		3783	`props(use), 0,`
		3784	`name_tag);`
		3785	`son(use) = new_use;`
		3786	`pt(prev) = new_use;`
		3787	`pt(use) = nilexp;`
		3788	`props(use) = (prop)0;`
		3789	`/* retain same no and sh */`
		3790	`setname(use, reff_tag);`
2	7u83	3791
6	7u83	3792	`use = new_use;`
		3793	`}`
		3794	`} /* for */`
2	7u83	3795
6	7u83	3796	`/* modify parameter itself */`
		3797	`mustbevis = isenvoff(param);`
		3798	`if (isoutpar(param)) {`
		3799	`props(param) = (prop)0;`
		3800	`setoutpar(param);`
		3801	`} else {`
		3802	`props(param) = (prop)0;`
		3803	`}`
		3804	`if (mustbevis) {`
		3805	`setvis(param);`
		3806	`}`
		3807	`setparam(param);`
		3808	`setcaonly(param);`
		3809	`setsh(son(param), ptr_s);`
		3810	`} /* if redo... */`
		3811	`varhack = 0;`
		3812	`/* apply check_id to the caller parameters */`
		3813	`IGNORE check_id(param, param);`
		3814	`} /* for */`
2	7u83	3815	`}`
		3816
6	7u83	3817	`if (callee_intro.number != 0) {`
		3818	`exp param= callee_intro.last_id;`
		3819	`int i;`
2	7u83	3820
6	7u83	3821	`for (i=callee_intro.number; i != 0;`
		3822	`param = father(param), i--) {`
2	7u83	3823
6	7u83	3824	`/* apply check_id to the callee parameters */`
		3825	`IGNORE check_id(param, param);`
		3826	`} /* for */`
		3827	`}`
2	7u83	3828
6	7u83	3829	`if (redo_structfns && !reg_result(result_shape)) {`
		3830	`if (proc_struct_result==nilexp) {`
		3831	`exp init = getexp(f_pointer(f_alignment(result_shape)),`
		3832	`nilexp, 0, nilexp, nilexp, 0, 0,`
		3833	`clear_tag);`
		3834	`exp iddec = getexp(sh(son(res)), nilexp, 0, init,`
		3835	`nilexp, 0, 0, ident_tag);`
		3836	`setparam(iddec);`
		3837	`proc_struct_result = iddec;`
		3838	`}`
2	7u83	3839
6	7u83	3840	`bro(son(proc_struct_result)) = son(res);`
		3841	`setfather(proc_struct_result, son(res));`
		3842	`son(res) = proc_struct_result;`
		3843	`setfather(res, proc_struct_result);`
		3844	`}`
2	7u83	3845
6	7u83	3846	`/* clear this flag to distinguish values created during procedure`
		3847	`reading. */`
		3848	`in_proc_def = 0;`
2	7u83	3849
6	7u83	3850	`set_make_procprops(res, prcprops);`
2	7u83	3851
6	7u83	3852	`pop_proc_props();`
		3853	`if (old_proc_props != (proc_props *)0 \|\| rep_make_proc) {`
		3854	`dec *extra_dec = make_extra_dec(make_local_name(), 0, 0, res,`
		3855	`f_proc);`
		3856	`exp e = extra_dec->dec_u.dec_val.dec_exp;`
		3857	`res = getexp(f_proc, nilexp, 0, e, nilexp, 0, 0, name_tag);`
		3858	`pt(e) = res;`
		3859	`no(e) = 1;`
		3860	`}`
2	7u83	3861
6	7u83	3862	`return res;`
2	7u83	3863	`}`
		3864
		3865
6	7u83	3866	`exp`
		3867	`find_caller_id(int n, exp p)`
2	7u83	3868	`{`
		3869	`while (name(p) == ident_tag) {`
6	7u83	3870	`if (name(son(p)) == caller_name_tag && no(son(p)) ==n) {`
2	7u83	3871	`return p;`
		3872	`}`
		3873	`p = bro(son(p));`
		3874	`}`
		3875	`return nilexp;`
		3876	`}`
		3877
6	7u83	3878
		3879	`void`
		3880	`start_apply_general_proc(shape result_shape, procprops_option prcprops, exp p,`
		3881	`otagexp_list caller_params_intro,`
		3882	`callees callee_params)`
2	7u83	3883	`{`
6	7u83	3884	`return;`
2	7u83	3885	`}`
		3886
6	7u83	3887
		3888	`exp`
		3889	`f_apply_general_proc(shape result_shape, procprops prcprops, exp p,`
		3890	`otagexp_list caller_pars, callees callee_pars,`
		3891	`exp postlude)`
2	7u83	3892	`{`
6	7u83	3893	`exp res = getexp(result_shape, nilexp, 0, p, nilexp, 0, 0,`
		3894	`apply_general_tag);`
		3895	`exp r_p;`
		3896	`exp redos = nilexp;`
2	7u83	3897	`exp last_redo;`
6	7u83	3898	`has_alloca = 1;`
2	7u83	3899
		3900	`if (name(callee_pars) == same_callees_tag) {`
		3901	`/* it's a constant */`
		3902	`callee_pars = copy(callee_pars);`
		3903	`}`
		3904
		3905
6	7u83	3906	`if (redo_structparams) {`
		3907	`int i;`
		3908	`exp *plce = &caller_pars.start;`
		3909	`for (i = 0; i < caller_pars.number; i++) {`
		3910	`exp ote = *plce;`
		3911	`exp param = (name(ote) == caller_tag) ? son(ote) : ote;`
		3912	`if ((name(sh(param)) == cpdhd \|\|`
		3913	`name(sh(param)) == nofhd \|\|`
		3914	`name(sh(param)) == doublehd)`
2	7u83	3915	`#if issparc`
6	7u83	3916	`\|\| sparccpd(sh(param))`
2	7u83	3917	`#endif`
6	7u83	3918	`#if ishppa`
		3919	`&& shape_size(sh(param)) >64`
2	7u83	3920	`#endif`
6	7u83	3921	`) {`
		3922	`/* make copy of par and use ptr as par */`
		3923	`shape nshape =`
		3924	`f_pointer(f_alignment(sh(param)));`
		3925	`exp rd = me_startid(nshape, param, 1);`
		3926	`exp npar = me_obtain(rd);`
		3927	`exp id;`
		3928	`if (name(ote) ==caller_tag &&`
		3929	`(id = find_caller_id(i, caller_pars.id)) !=`
		3930	`nilexp) {`
		3931	`exp p = pt(id);`
		3932	`son(ote) = npar;`
		3933	`bro(npar) = ote;`
		3934	`setlast(npar);`
		3935	`sh(son(id)) = sh(npar);`
		3936	`while(p != nilexp) {`
		3937	`/* replaces uses in postlude */`
		3938	`exp bp = bro(p);`
		3939	`int l = last(p);`
		3940	`exp np = pt(p);`
		3941	`exp *pos = refto(father(p), p);`
		3942	`exp c;`
		3943	`sh(p) = nshape;`
		3944	`c = f_contents(sh(ote), p);`
		3945	`if (l) {`
		3946	`setlast(c);`
		3947	`} else {`
		3948	`clearlast(c);`
		3949	`}`
		3950	`bro(c) = bp;`
		3951	`*pos = c;`
		3952	`p = np;`
		3953	`}`
		3954	`sh(ote) = nshape;`
		3955	`plce = &bro(ote);`
		3956	`} else {`
		3957	`if (last(ote)) {`
		3958	`setlast(npar);`
		3959	`}`
		3960	`bro(npar) = bro(ote);`
		3961	`if (ote == caller_pars.end) {`
		3962	`caller_pars.end = npar;`
		3963	`}`
		3964	`*plce = npar;`
		3965	`plce = &bro(npar);`
		3966	`}`
		3967	`bro(son(rd)) = redos;`
		3968	`clearlast(son(rd));`
		3969	`if (redos != nilexp) {`
		3970	`bro(redos) = rd;`
		3971	`setlast(redos);`
		3972	`} else {`
		3973	`last_redo = rd;`
		3974	`}`
		3975	`redos = rd;`
		3976	`} else {`
		3977	`plce = &bro(ote);}`
		3978	`}`
2	7u83	3979	`}`
		3980
6	7u83	3981	`if (caller_pars.id != nilexp) {`
		3982	`exp a = caller_pars.id;`
		3983	`while (bro(son(a)) != nilexp) {`
		3984	`a = bro(son(a));`
		3985	`}`
		3986	`bro(son(a)) = postlude;`
		3987	`setfather(a, postlude);`
		3988	`postlude = caller_pars.id;`
		3989	`}`
2	7u83	3990
6	7u83	3991	`setfather(res, postlude);`
2	7u83	3992
6	7u83	3993	`bro(callee_pars) = postlude;`
		3994	`clearlast(callee_pars);`
		3995	`props(callee_pars) = prcprops;`
2	7u83	3996
6	7u83	3997	`r_p = getexp(f_top, callee_pars, 0, caller_pars.start, nilexp, prcprops,`
		3998	`caller_pars.number, 0);`
		3999	`if (caller_pars.number != 0) {`
		4000	`setfather(r_p, caller_pars.end);`
		4001	`}`
2	7u83	4002
6	7u83	4003	`bro(p) = r_p; clearlast(p);`
2	7u83	4004	`#ifdef promote_pars`
6	7u83	4005	`{ int i;`
		4006	`exp ote = caller_pars.start;`
		4007	`for (i = 0; i < caller_pars.number; i++) {`
		4008	`shape s = sh(ote);`
		4009	`if (name(s) >= scharhd && name(s) <= uwordhd) {`
		4010	`shape ns = (is_signed(s)) ? slongsh : ulongsh;`
		4011	`exp par = (name(ote) == caller_tag) ?`
		4012	`son(ote) : ote;`
		4013	`exp next = bro(ote);`
		4014	`exp id;`
		4015	`int l = last(ote);`
		4016	`exp w = hold_check(f_change_variety(f_wrap, ns,`
		4017	`copy(par)));`
		4018	`if (name(ote) == caller_tag) {`
		4019	`sh(ote) = ns;`
		4020	`}`
		4021	`replace(par, w, nilexp);`
		4022	`kill_exp(par, nilexp);`
		4023	`if (name(ote) == caller_tag &&`
		4024	`(id = find_caller_id(i, postlude)) !=`
		4025	`nilexp) {`
		4026	`exp p = pt(id);`
		4027	`sh(son(id)) = ns;`
		4028	`while(p != nilexp) {`
		4029	`/* replaces uses in postlude */`
		4030	`exp nextp = pt(p);`
		4031	`sh(p) = ns;`
		4032	`w = f_change_variety(f_wrap, s,`
		4033	`copy(p));`
		4034	`replace(p, w, nilexp);`
		4035	`kill_exp(p, nilexp);`
		4036	`p = nextp;`
		4037	`}`
		4038	`}`
		4039	`if (l) {`
		4040	`break;`
		4041	`}`
		4042	`ote = next;`
		4043	`} else ote = bro(ote);`
2	7u83	4044	`}`
		4045	`}`
		4046	`#endif`
		4047
6	7u83	4048	`if (redo_structfns && !reg_result(result_shape))`
		4049	`{`
		4050	`/* replace f(x) by {var r; f(r, x); cont(r)} */`
		4051	`exp init, vardec, cont, contname, seq, app, appname, tmp;`
		4052	`exp_list list;`
		4053	`shape ptr_res_shape = f_pointer(f_alignment(result_shape));`
2	7u83	4054
6	7u83	4055	`init = getexp(result_shape, nilexp, 0, nilexp, nilexp, 0, 0,`
		4056	`clear_tag);`
		4057	`vardec = getexp(result_shape, nilexp, 0, init, nilexp, 0, 1,`
		4058	`ident_tag);`
		4059	`setvar(vardec);`
		4060	`contname = getexp(ptr_res_shape, nilexp, 0, vardec, nilexp, 0,`
		4061	`0, name_tag);`
		4062	`pt(vardec) = contname;`
		4063	`cont = f_contents(result_shape, contname);`
2	7u83	4064
6	7u83	4065	`appname = getexp(ptr_res_shape, son(r_p), 0, vardec, contname,`
		4066	`0, 0, name_tag);`
		4067	`if (no(r_p)++ == 0) {`
		4068	`setfather(r_p, appname);`
		4069	`}`
		4070	`++no(vardec);`
		4071	`pt(vardec) = appname;`
		4072	`app = getexp(f_top, nilexp, 0, son(res), nilexp, 0, 32,`
		4073	`apply_general_tag);`
		4074	`son(r_p) = appname;`
2	7u83	4075
6	7u83	4076	`tmp = postlude;`
		4077	`while (name(tmp) ==ident_tag &&`
		4078	`name(son(tmp)) == caller_name_tag) {`
		4079	`no(son(tmp))++;`
		4080	`tmp = bro(son(tmp));`
		4081	`}`
2	7u83	4082
6	7u83	4083	`bro(postlude) = app;`
		4084	`list.number = 1;`
		4085	`list.start = app;`
		4086	`list.end = app;`
		4087	`seq = f_sequence(list, cont);`
		4088	`bro(init) = seq;`
		4089	`setfather(vardec, seq);`
		4090	`retcell(res);`
		4091	`res = vardec;`
		4092	`}`
2	7u83	4093
6	7u83	4094	`if (redos != nilexp) {`
		4095	`/* put in decs given by redo_structparams */`
		4096	`bro(son(last_redo)) = res;`
		4097	`clearlast(son(last_redo));`
		4098	`bro(res) = last_redo;`
		4099	`setlast(res);`
		4100	`res = redos;`
		4101	`}`
2	7u83	4102
6	7u83	4103	`return res;`
2	7u83	4104	`}`
		4105
		4106
6	7u83	4107	`exp`
		4108	`f_tail_call(procprops prcprops, exp p, callees callee_params)`
2	7u83	4109	`{`
6	7u83	4110	`exp res = getexp(f_bottom, nilexp, 0, p, nilexp, 0, 0, tail_call_tag);`
2	7u83	4111	`exp e_p;`
		4112	`if (name(callee_params) == same_callees_tag) {`
		4113	`/* it's a constant */`
		4114	`callee_params = copy(callee_params);`
		4115	`}`
6	7u83	4116	`e_p = getexp(f_top, res, 1, callee_params, nilexp, prcprops, 0, 0);`
		4117	`has_setjmp = 1; /* stop inlining! */`
2	7u83	4118	`has_alloca = 1; /* make sure has fp */`
		4119	`props(callee_params) = prcprops;`
6	7u83	4120	`bro(p) = callee_params;`
		4121	`clearlast(p);`
2	7u83	4122	`setfather(res, callee_params);`
		4123	`return res;`
		4124	`}`
		4125
		4126
6	7u83	4127	`exp`
		4128	`f_untidy_return(exp arg)`
2	7u83	4129	`{`
6	7u83	4130	`exp res = getexp(f_bottom, nilexp, 0, arg, nilexp, 0, 0,`
		4131	`untidy_return_tag);`
		4132	`setfather(res, arg);`
2	7u83	4133	`has_setjmp = 1;`
6	7u83	4134	`return res;`
		4135	`}`
2	7u83	4136
6	7u83	4137
		4138	`alignment`
		4139	`f_parameter_align(alignment a)`
2	7u83	4140	`{`
6	7u83	4141	`return (f_var_param_alignment);`
2	7u83	4142
		4143	`}`
		4144
6	7u83	4145	`exp`
		4146	`f_set_stack_limit(exp flim)`
2	7u83	4147	`{`
		4148	`return me_u3(f_top, flim, set_stack_limit_tag);`
		4149	`}`
		4150
6	7u83	4151	`exp`
		4152	`f_give_stack_limit(alignment frame_al)`
2	7u83	4153	`{`
		4154	`exp res = getexp(f_pointer(frame_al), nilexp, 0, nilexp, nilexp, 0, 0,`
6	7u83	4155	`give_stack_limit_tag);`
2	7u83	4156	`return res;`
		4157	`}`
		4158
6	7u83	4159	`exp`
		4160	`f_make_stack_limit(exp stack_base, exp frame_size, exp alloca_size)`
2	7u83	4161	`{`
		4162
		4163	`exp sz;`
6	7u83	4164	`frame_size = hold_check(f_offset_pad(al1_of(sh(alloca_size)),`
		4165	`frame_size));`
		4166	`alloca_size = hold_check(f_offset_pad(f_alignment(ucharsh),`
		4167	`alloca_size));`
2	7u83	4168	`sz = hold_check(f_offset_add(frame_size, alloca_size));`
		4169	`return me_b2(stack_base, sz, make_stack_limit_tag);`
		4170	`}`
6	7u83	4171
		4172
		4173	`exp`
		4174	`f_env_size(tag proctag)`
2	7u83	4175	`{`
6	7u83	4176	`exp res = getexp(f_offset(f_locals_alignment, f_locals_alignment),`
		4177	`nilexp, 0, f_obtain_tag(proctag), nilexp, 0, 0,`
		4178	`env_size_tag);`
		4179	`bro(son(res)) = res;`
		4180	`setlast(son(res));`
2	7u83	4181	`return res;`
		4182	`}`
		4183
		4184
		4185
6	7u83	4186	`nat`
		4187	`f_error_val(error_code ec)`
2	7u83	4188	`{`
		4189	`nat res;`
		4190	`nat_issmall(res) =1;`
		4191	`natint(res) = ec;`
		4192	`return res;`
		4193	`}`
		4194
6	7u83	4195	`exp`
		4196	`f_make_top(void)`
2	7u83	4197	`{`
6	7u83	4198	`return getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, top_tag);`
2	7u83	4199	`}`
		4200
6	7u83	4201	`exp`
		4202	`f_make_value(shape s)`
2	7u83	4203	`{`
6	7u83	4204	`return me_l1(s, clear_tag);`
2	7u83	4205	`}`
		4206
6	7u83	4207	`exp`
		4208	`f_minus(error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	4209	`{`
6	7u83	4210	`if (name(sh(arg1)) == bothd) {`
		4211	`kill_exp(arg2, arg2);`
		4212	`return arg1;`
		4213	`}`
		4214	`if (name(sh(arg2)) == bothd) {`
		4215	`kill_exp(arg1, arg1);`
		4216	`return arg2;`
		4217	`}`
2	7u83	4218
		4219	`#if check_shape`
6	7u83	4220	`if (!eq_shape(sh(arg1), sh(arg2)) \|\| !is_integer(sh(arg1))) {`
		4221	`failer(CHSH_MINUS);`
		4222	`}`
2	7u83	4223	`#endif`
		4224	`#if !has64bits`
		4225	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	4226	`(name(arg1) != val_tag \|\| name(arg2) != val_tag \|\|`
		4227	`ov_err.err_code > 2)) {`
		4228	`return TDFcallop2(ov_err, arg1, arg2, minus_tag);`
2	7u83	4229	`}`
		4230	`#endif`
6	7u83	4231	`return me_b1(ov_err, arg1, arg2, minus_tag);`
2	7u83	4232	`}`
		4233
6	7u83	4234	`exp`
		4235	`f_move_some(transfer_mode md, exp arg1, exp arg2, exp arg3)`
2	7u83	4236	`{`
6	7u83	4237	`exp r = getexp(f_top, nilexp, 0, arg1, nilexp, 0, 0, movecont_tag);`
		4238	`if (name(sh(arg1)) == bothd) {`
		4239	`kill_exp(arg2, arg2);`
		4240	`kill_exp(arg3, arg3);`
		4241	`return arg1;`
		4242	`}`
		4243	`if (name(sh(arg2)) == bothd) {`
		4244	`kill_exp(arg1, arg1);`
		4245	`kill_exp(arg3, arg3);`
		4246	`return arg2;`
		4247	`}`
		4248	`if (name(sh(arg3)) == bothd) {`
		4249	`kill_exp(arg1, arg1);`
		4250	`kill_exp(arg2, arg2);`
		4251	`return arg3;`
		4252	`}`
2	7u83	4253
		4254	`#if check_shape`
6	7u83	4255	`if (name(sh(arg1)) != ptrhd \|\| name(sh(arg2)) != ptrhd \|\|`
		4256	`name(sh(arg3)) != offsethd \|\| al1(sh(arg1)) < al1(sh(arg3)) \|\|`
		4257	`al1(sh(arg2)) < al1(sh(arg3))) {`
		4258	`failer(CHSH_MOVESOME);`
		4259	`}`
2	7u83	4260	`#endif`
		4261	`#ifdef no_trap_on_nil_contents`
		4262	`if ((md & f_trap_on_nil) != 0) {`
		4263	`exp d2 = me_startid(f_top, arg2, 0);`
6	7u83	4264	`exp d1 = me_startid(f_top, arg1, 0);`
		4265	`exp hldr = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, 0);`
		4266	`exp lb = getexp(f_top, nilexp, 0, hldr, nilexp, 0, 0,`
		4267	`labst_tag);`
2	7u83	4268	`exp_list el;`
6	7u83	4269	`exp test2 = me_q1(no_nat_option, f_not_equal, &lb,`
		4270	`me_obtain(d2),`
		4271	`f_make_null_ptr(al1_of(sh(arg2))), test_tag);`
		4272	`exp test1 = me_q1(no_nat_option, f_not_equal, &lb,`
		4273	`me_obtain(d1), f_make_null_ptr(al1_of(`
		4274	`sh(arg1))), test_tag);`
		4275	`exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,`
		4276	`f_nil_access, trap_tag);`
2	7u83	4277	`md &= ~f_trap_on_nil;`
6	7u83	4278	`el = new_exp_list(2);`
		4279	`el = add_exp_list(el, test1, 1);`
		4280	`el = add_exp_list(el, test2, 2);`
2	7u83	4281
6	7u83	4282	`return me_complete_id(d2, me_complete_id(d1, f_conditional(&lb,`
		4283	`f_sequence(el, f_move_some(md, me_obtain(d1), me_obtain(d2),`
		4284	`arg3)), trp)));`
		4285	`}`
2	7u83	4286	`#endif`
6	7u83	4287	`if (!(md & f_overlap) && name(arg3) == val_tag && al2(sh(arg3)) > 1) {`
		4288	`exp c = f_contents(f_compound(arg3), arg1);`
		4289	`return f_assign(arg2, c);`
		4290	`}`
2	7u83	4291
6	7u83	4292	`if (al2(sh(arg3)) < 8) {`
		4293	`arg3 = hold_check(f_offset_pad(f_alignment(ucharsh), arg3));`
		4294	`}`
2	7u83	4295
6	7u83	4296	`if (!(md & f_overlap)) {`
		4297	`setnooverlap(r);`
		4298	`}`
		4299	`clearlast(arg1);`
		4300	`setbro(arg1, arg2);`
		4301	`clearlast(arg2);`
		4302	`setbro(arg2, arg3);`
		4303	`setfather(r, arg3);`
		4304	`return r;`
2	7u83	4305	`}`
		4306
6	7u83	4307
		4308	`exp`
		4309	`f_mult(error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	4310	`{`
6	7u83	4311	`if (name(sh(arg1)) == bothd) {`
		4312	`kill_exp(arg2, arg2);`
		4313	`return arg1;`
		4314	`}`
		4315	`if (name(sh(arg2)) == bothd) {`
		4316	`kill_exp(arg1, arg1);`
		4317	`return arg2;`
		4318	`}`
2	7u83	4319
		4320	`#if check_shape`
6	7u83	4321	`if (!eq_shape(sh(arg1), sh(arg2)) \|\| !is_integer(sh(arg1))) {`
		4322	`failer(CHSH_MULT);`
		4323	`}`
2	7u83	4324	`#endif`
		4325	`#if !has64bits`
		4326	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	4327	`(name(arg1) != val_tag \|\| name(arg2) != val_tag \|\|`
		4328	`ov_err.err_code > 2)) {`
		4329	`return TDFcallop2(ov_err, arg1, arg2, mult_tag);`
2	7u83	4330	`}`
		4331	`#endif`
		4332
6	7u83	4333	`return me_b1(ov_err, arg1, arg2, mult_tag);`
2	7u83	4334	`}`
		4335
6	7u83	4336
		4337	`exp`
		4338	`f_n_copies(nat n, exp arg1)`
2	7u83	4339	`{`
6	7u83	4340	`exp r;`
		4341	`if (name(sh(arg1)) == bothd) {`
		4342	`return arg1;`
		4343	`}`
2	7u83	4344
		4345	`#if !has64bits`
6	7u83	4346	`if (!nat_issmall(n)) {`
		4347	`failer(TOO_BIG_A_VECTOR);`
		4348	`}`
2	7u83	4349	`#endif`
		4350
6	7u83	4351	`r = getexp(f_nof(n, sh(arg1)), nilexp, 0, arg1, nilexp, 0, natint(n),`
		4352	`ncopies_tag);`
		4353	`if (name(sh(arg1)) == bitfhd) {`
		4354	`/* make ncopies bitfields into (ncopies) make-compound */`
		4355	`int sf = shape_size(sh(arg1));`
		4356	`int snof = shape_size(sh(r));`
		4357	`int scs = (((sf - 1) &sf) ==0) ? sf : snof;`
		4358	`shape cs = containedshape(scs, 1);`
		4359	`exp_list a;`
		4360	`shape cpds = f_compound(hold_check(f_offset_pad(f_alignment(cs),`
		4361	`f_shape_offset(sh(r)))));`
		4362	`exp soff = getexp(f_offset(f_alignment(cpds),`
		4363	`f_alignment(sh(arg1))), nilexp, 0,`
		4364	`nilexp, nilexp, 0, 0, val_tag);`
		4365	`exp cexp;`
		4366	`a.start = copyexp(soff);`
		4367	`a.end = a.start;`
		4368	`a.number = 2;`
2	7u83	4369	`bro(a.end) = copyexp(arg1);`
		4370	`a.end = bro(a.end);`
6	7u83	4371	`for (no(soff) = sf; no(soff) <= shape_size(cs) -sf;`
		4372	`no(soff) +=sf) {`
		4373	`bro(a.end) = copyexp(soff);`
		4374	`clearlast(a.end);`
		4375	`a.end = bro(a.end);`
		4376	`bro(a.end) = copyexp(arg1);`
		4377	`a.end = bro(a.end);`
		4378	`a.number += 2;`
		4379	`}`
2	7u83	4380
6	7u83	4381	`setlast(a.end);`
		4382	`bro(a.end) = nilexp;`
		4383	`cexp = f_make_compound(hold_check(f_shape_offset(cs)), a);`
		4384	`if (shape_size(cs) >= shape_size(cpds)) {`
		4385	`return cexp;`
		4386	`} else {`
		4387	`natint(n) = shape_size(cpds) / shape_size(cs);`
		4388	`return f_n_copies(n, cexp);`
		4389	`}`
2	7u83	4390	`}`
		4391
6	7u83	4392	`setfather(r, arg1);`
		4393	`return r;`
2	7u83	4394	`}`
		4395
6	7u83	4396
		4397	`exp`
		4398	`f_negate(error_treatment ov_err, exp arg1)`
2	7u83	4399	`{`
6	7u83	4400	`if (name(sh(arg1)) == bothd) {`
		4401	`return arg1;`
		4402	`}`
2	7u83	4403
		4404	`#if check_shape`
6	7u83	4405	`if (!is_integer(sh(arg1))) {`
		4406	`failer(CHSH_NEGATE);`
		4407	`}`
2	7u83	4408	`#endif`
6	7u83	4409	`if (!is_signed(sh(arg1)) && ov_err.err_code > 2) {`
		4410	`return f_minus(ov_err, me_shint(sh(arg1), 0), arg1);`
		4411	`}`
2	7u83	4412	`#if !has64bits`
		4413	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	4414	`(name(arg1) != val_tag\|\| ov_err.err_code > 2)) {`
		4415	`return TDFcallop1(ov_err, arg1, neg_tag);`
2	7u83	4416	`}`
		4417	`#endif`
		4418
6	7u83	4419	`return me_u1(ov_err, arg1, neg_tag);`
2	7u83	4420	`}`
		4421
6	7u83	4422
		4423	`exp`
		4424	`f_not(exp arg1)`
2	7u83	4425	`{`
6	7u83	4426	`if (name(sh(arg1)) == bothd) {`
		4427	`return arg1;`
		4428	`}`
2	7u83	4429
		4430	`#if check_shape`
6	7u83	4431	`if (!is_integer(sh(arg1))) {`
		4432	`failer(CHSH_NOT);`
		4433	`}`
2	7u83	4434	`#endif`
		4435	`#if !has64bits`
		4436	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	4437	`name(arg1) != val_tag) {`
		4438	`return TDFcallop4(arg1, not_tag);`
2	7u83	4439	`}`
		4440	`#endif`
6	7u83	4441	`return me_u2(arg1, not_tag);`
2	7u83	4442	`}`
		4443
6	7u83	4444
		4445	`exp`
		4446	`f_obtain_tag(tag t)`
2	7u83	4447	`{`
6	7u83	4448	`shape s;`
		4449	`exp r;`
		4450	`exp tg = get_tag(t);`
2	7u83	4451
6	7u83	4452	`if (tg == nilexp) {`
		4453	`failer(UNDEF_TAG);`
		4454	`}`
2	7u83	4455
6	7u83	4456	`if (isglob(tg)) {`
		4457	`s = sh(t->dec_u.dec_val.dec_exp);`
2	7u83	4458	`#ifdef NEWDIAGS`
6	7u83	4459	`if (!within_diags) {`
		4460	`proc_externs = 1;`
		4461	`}`
2	7u83	4462	`#else`
6	7u83	4463	`proc_externs = 1;`
2	7u83	4464	`#endif`
6	7u83	4465	`} else {`
		4466	`s = sh(son(tg));`
		4467	`}`
2	7u83	4468
6	7u83	4469	`if (isvar(tg)) {`
		4470	`if (isparam(tg)) {`
		4471	`s = f_pointer(f_parameter_alignment(s));`
		4472	`} else {`
		4473	`s = f_pointer(f_alignment(s));`
		4474	`}`
		4475	`}`
2	7u83	4476
6	7u83	4477	`r = getexp(s, nilexp, 0, tg, pt(tg), 0, 0, name_tag);`
		4478	`pt(tg) = r;`
		4479	`no(tg) = no(tg) +1;`
		4480	`return (r);`
2	7u83	4481	`}`
		4482
6	7u83	4483
		4484	`exp`
		4485	`f_offset_add(exp arg1, exp arg2)`
2	7u83	4486	`{`
6	7u83	4487	`shape sres;`
		4488	`if (name(sh(arg1)) == bothd) {`
		4489	`kill_exp(arg2, arg2);`
		4490	`return arg1;`
		4491	`}`
		4492	`if (name(sh(arg2)) == bothd) {`
		4493	`kill_exp(arg1, arg1);`
		4494	`return arg2;`
		4495	`}`
2	7u83	4496
		4497
		4498	`#if check_shape`
6	7u83	4499	`if (!doing_aldefs &&`
		4500	`((name(sh(arg1)) != offsethd \|\| name(sh(arg2)) != offsethd \|\|`
		4501	`(al1(sh(arg2)) > al2(sh(arg1))`
2	7u83	4502	`#if issparc`
6	7u83	4503	`&& al1_of(sh(arg2)) != REAL_ALIGN`
2	7u83	4504	`#endif`
6	7u83	4505	`)))) {`
		4506	`failer(CHSH_OFFSETADD);`
		4507	`}`
2	7u83	4508	`#endif`
6	7u83	4509	`sres = f_offset(al1_of(sh(arg1)), al2_of(sh(arg2)));`
2	7u83	4510	`#if 0`
6	7u83	4511	`if ((al1_of(sh(arg1))->al.al_val.al_frame & 4) != 0 &&`
		4512	`al2_of(sh(arg2))->al.sh_hd != 0) {`
2	7u83	4513	`exp ne;`
		4514	`if (al2_of(sh(arg2))->al.sh_hd > nofhd) {`
6	7u83	4515	`shape ps = f_pointer(f_alignment(sh(arg1)));`
		4516	`ne = hold_check(f_offset_pad(f_alignment(ps),`
		4517	`f_shape_offset(ps)));`
		4518	`} else {`
2	7u83	4519	`ne = arg2;`
		4520	`}`
		4521	`arg2 = hold_check(me_u2(ne, offset_negate_tag));`
6	7u83	4522	`}`
2	7u83	4523	`#endif`
6	7u83	4524	`return me_b3(sres, arg1, arg2, offset_add_tag);`
2	7u83	4525	`}`
		4526
6	7u83	4527
		4528	`exp`
		4529	`f_offset_div(variety v, exp arg1, exp arg2)`
2	7u83	4530	`{`
6	7u83	4531	`if (name(sh(arg1)) == bothd) {`
		4532	`kill_exp(arg2, arg2);`
		4533	`return arg1;`
		4534	`}`
		4535	`if (name(sh(arg2)) == bothd) {`
		4536	`kill_exp(arg1, arg1);`
		4537	`return arg2;`
		4538	`}`
2	7u83	4539	`#if check_shape`
6	7u83	4540	`if (name(sh(arg1)) != offsethd \|\| name(sh(arg2)) != offsethd) {`
		4541	`failer(CHSH_OFFSETDIV);`
		4542	`}`
2	7u83	4543	`#endif`
		4544
6	7u83	4545	`return me_b3(f_integer(v), arg1, arg2, offset_div_tag);`
2	7u83	4546	`}`
		4547
6	7u83	4548
		4549	`exp`
		4550	`f_offset_div_by_int(exp arg1, exp arg2)`
2	7u83	4551	`{`
6	7u83	4552	`if (name(sh(arg1)) == bothd) {`
		4553	`kill_exp(arg2, arg2);`
		4554	`return arg1;`
		4555	`}`
		4556	`if (name(sh(arg2)) == bothd) {`
		4557	`kill_exp(arg1, arg1);`
		4558	`return arg2;`
		4559	`}`
2	7u83	4560
		4561	`#if check_shape`
6	7u83	4562	`if (!doing_aldefs &&`
		4563	`(name(sh(arg1)) != offsethd \|\| !is_integer(sh(arg2)) \|\|`
		4564	`(al1(sh(arg1)) != al2(sh(arg1)) && al2(sh(arg1)) != 1))) {`
		4565	`failer(CHSH_OFFSETDIVINT);`
		4566	`}`
2	7u83	4567	`#endif`
		4568
6	7u83	4569	`return me_b3(sh(arg1), arg1, arg2, offset_div_by_int_tag);`
2	7u83	4570	`}`
		4571
6	7u83	4572
		4573	`exp`
		4574	`f_offset_max(exp arg1, exp arg2)`
2	7u83	4575	`{`
6	7u83	4576	`alignment a1 = al1_of(sh(arg1));`
		4577	`alignment a2 = al1_of(sh(arg2));`
		4578	`alignment a3 = al2_of(sh(arg1));`
		4579	`shape sha;`
		4580	`if (name(sh(arg1)) == bothd) {`
		4581	`kill_exp(arg2, arg2);`
		4582	`return arg1;`
		4583	`}`
		4584	`if (name(sh(arg2)) == bothd) {`
		4585	`kill_exp(arg1, arg1);`
		4586	`return arg2;`
		4587	`}`
2	7u83	4588
		4589	`#if check_shape`
6	7u83	4590	`if (!doing_aldefs &&`
		4591	`(name(sh(arg1)) != offsethd \|\| name(sh(arg2)) != offsethd)) {`
		4592	`failer(CHSH_OFFSETMAX);`
		4593	`}`
2	7u83	4594	`#endif`
		4595
6	7u83	4596	`if (a1->al.al_n != 1 \|\| a2->al.al_n != 1) {`
		4597	`alignment ares = (alignment)calloc(1, sizeof(aldef));`
		4598	`if (!doing_aldefs) {`
		4599	`failer(CHSH_OFFSETMAX);`
		4600	`}`
		4601	`ares->al.al_n = 2;`
		4602	`ares->al.al_val.al_join.a = a1;`
		4603	`ares->al.al_val.al_join.b = a2;`
		4604	`ares->next_aldef = top_aldef;`
		4605	`top_aldef = ares;`
		4606	`sha = f_offset(ares, a3);`
		4607	`} else {`
		4608	`sha = f_offset(long_to_al(max(a1->al.al_val.al,`
		4609	`a2->al.al_val.al)), a3);`
		4610	`}`
2	7u83	4611
6	7u83	4612	`return me_b3(sha, arg1, arg2, offset_max_tag);`
2	7u83	4613	`}`
6	7u83	4614
		4615
		4616	`exp`
		4617	`f_offset_mult(exp arg1, exp arg2)`
2	7u83	4618	`{`
6	7u83	4619	`if (name(sh(arg1)) == bothd) {`
		4620	`kill_exp(arg2, arg2);`
		4621	`return arg1;`
		4622	`}`
		4623	`if (name(sh(arg2)) == bothd) {`
		4624	`kill_exp(arg1, arg1);`
		4625	`return arg2;`
		4626	`}`
2	7u83	4627
		4628	`#if check_shape`
6	7u83	4629	`if (!doing_aldefs &&`
		4630	`(name(sh(arg1)) != offsethd \|\| !is_integer(sh(arg2)))) {`
		4631	`failer(CHSH_OFFSETMULT);`
		4632	`}`
2	7u83	4633	`#endif`
		4634
6	7u83	4635	`if (shape_size(sh(arg2)) != PTR_SZ) {`
		4636	`if (PTR_SZ == 32) {`
		4637	`arg2 = hold_check(f_change_variety(f_impossible,`
		4638	`slongsh, arg2));`
		4639	`} else {`
		4640	`arg2 = hold_check(f_change_variety(f_impossible,`
		4641	`s64sh, arg2));`
		4642	`}`
		4643	`}`
2	7u83	4644
6	7u83	4645	`return me_b3(sh(arg1), arg2, arg1, offset_mult_tag);`
		4646	`/* the order of arguments is being interchanged */`
2	7u83	4647	`}`
		4648
6	7u83	4649
		4650	`exp`
		4651	`f_offset_negate(exp arg1)`
2	7u83	4652	`{`
6	7u83	4653	`if (name(sh(arg1)) == bothd) {`
		4654	`return arg1;`
		4655	`}`
2	7u83	4656
		4657	`#if check_shape`
6	7u83	4658	`if (!doing_aldefs &&`
		4659	`(name(sh(arg1)) != offsethd \|\|`
		4660	`(al1(sh(arg1)) != al2(sh(arg1)) && al2(sh(arg1)) != 1`
2	7u83	4661	`#if issparc`
6	7u83	4662	`&& al1_of(sh(arg1)) != REAL_ALIGN`
2	7u83	4663	`#endif`
6	7u83	4664	`))) {`
		4665	`failer(CHSH_OFFSETNEG);`
		4666	`}`
2	7u83	4667	`#endif`
		4668
6	7u83	4669	`return me_u2(arg1, offset_negate_tag);`
2	7u83	4670	`}`
		4671
6	7u83	4672
		4673	`exp`
		4674	`f_offset_pad(alignment a, exp arg1)`
2	7u83	4675	`{`
6	7u83	4676	`shape sha;`
		4677	`if (name(sh(arg1)) == bothd) {`
		4678	`return arg1;`
		4679	`}`
2	7u83	4680
		4681	`#if check_shape`
6	7u83	4682	`if (name(sh(arg1)) != offsethd) {`
		4683	`failer(CHSH_OFFSETPAD);`
		4684	`}`
2	7u83	4685	`#endif`
		4686
6	7u83	4687	`if (a->al.al_n != 1 \|\| al1_of(sh(arg1))->al.al_n != 1) {`
		4688	`alignment ares = (alignment)calloc(1, sizeof(aldef));`
		4689	`if (!doing_aldefs) {`
		4690	`failer(ILL_OFFSETPAD);`
		4691	`}`
		4692	`ares->al.al_n = 2;`
		4693	`ares->al.al_val.al_join.a = a;`
		4694	`ares->al.al_val.al_join.b = al1_of(sh(arg1));`
		4695	`ares->next_aldef = top_aldef;`
		4696	`top_aldef = ares;`
		4697	`sha = f_offset(ares, a);`
		4698	`} else if (al1_of(sh(arg1))->al.al_val.al_frame != 0) {`
		4699	`sha = f_offset(al1_of(sh(arg1)), a);`
		4700	`} else {`
		4701	`sha = f_offset(long_to_al(max(a->al.al_val.al, al1(sh(arg1)))),`
		4702	`a);`
		4703	`}`
2	7u83	4704
6	7u83	4705	`return (me_u3(sha, arg1, offset_pad_tag));`
2	7u83	4706	`}`
		4707
		4708
6	7u83	4709	`exp`
		4710	`f_offset_subtract(exp arg1, exp arg2)`
2	7u83	4711	`{`
6	7u83	4712	`if (name(sh(arg1)) == bothd) {`
		4713	`kill_exp(arg2, arg2);`
		4714	`return arg1;`
		4715	`}`
		4716	`if (name(sh(arg2)) == bothd) {`
		4717	`kill_exp(arg1, arg1);`
		4718	`return arg2;`
		4719	`}`
2	7u83	4720
6	7u83	4721	`return me_b3(f_offset(al2_of(sh(arg2)), al2_of(sh(arg1))), arg1, arg2,`
		4722	`offset_subtract_tag);`
2	7u83	4723	`}`
		4724
6	7u83	4725
		4726	`exp`
		4727	`f_offset_test(nat_option prob, ntest nt, label dest, exp arg1, exp arg2)`
2	7u83	4728	`{`
6	7u83	4729	`if (name(sh(arg1)) == bothd) {`
		4730	`kill_exp(arg2, arg2);`
		4731	`return arg1;`
		4732	`}`
		4733	`if (name(sh(arg2)) == bothd) {`
		4734	`kill_exp(arg1, arg1);`
		4735	`return arg2;`
		4736	`}`
2	7u83	4737
		4738	`#if check_shape`
6	7u83	4739	`if (!doing_aldefs &&`
		4740	`(name(sh(arg1)) != offsethd \|\| name(sh(arg2)) != offsethd \|\|`
		4741	`/* al1(sh(arg1)) != al1(sh(arg2)) \|\| */`
		4742	`al2(sh(arg1)) != al2(sh(arg2)))) {`
		4743	`failer(CHSH_OFFSETTEST);`
		4744	`}`
2	7u83	4745	`#endif`
		4746
6	7u83	4747	`if (nt == f_comparable \|\| nt == f_not_comparable) {`
		4748	`return replace_ntest(nt, dest, arg1, arg2);`
		4749	`} else {`
		4750	`return me_q1(prob, convert_ntest[nt], dest, arg1, arg2,`
		4751	`test_tag);`
		4752	`}`
2	7u83	4753	`}`
		4754
6	7u83	4755
		4756	`exp`
		4757	`f_offset_zero(alignment a)`
2	7u83	4758	`{`
6	7u83	4759	`return getexp(f_offset(a, a), nilexp, 0, nilexp, nilexp, 0, 0, val_tag);`
2	7u83	4760	`}`
		4761
6	7u83	4762
		4763	`exp`
		4764	`f_or(exp arg1, exp arg2)`
2	7u83	4765	`{`
6	7u83	4766	`if (name(sh(arg1)) == bothd) {`
		4767	`kill_exp(arg2, arg2);`
		4768	`return arg1;`
		4769	`}`
		4770	`if (name(sh(arg2)) == bothd) {`
		4771	`kill_exp(arg1, arg1);`
		4772	`return arg2;`
		4773	`}`
2	7u83	4774
		4775	`#if check_shape`
6	7u83	4776	`if (!eq_shape(sh(arg1), sh(arg2)) \|\| !is_integer(sh(arg1))) {`
		4777	`failer(CHSH_OR);`
		4778	`}`
2	7u83	4779	`#endif`
		4780	`#if !has64bits`
		4781	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	4782	`(name(arg1) != val_tag \|\| name(arg2) != val_tag)) {`
		4783	`return TDFcallop3(arg1, arg2, or_tag);`
2	7u83	4784	`}`
		4785	`#endif`
6	7u83	4786	`return me_b2(arg1, arg2, or_tag);`
2	7u83	4787	`}`
		4788
6	7u83	4789
		4790	`exp`
		4791	`f_plus(error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	4792	`{`
6	7u83	4793	`if (name(sh(arg1)) == bothd) {`
		4794	`kill_exp(arg2, arg2);`
		4795	`return arg1;`
		4796	`}`
		4797	`if (name(sh(arg2)) == bothd) {`
		4798	`kill_exp(arg1, arg1);`
		4799	`return arg2;`
		4800	`}`
2	7u83	4801
		4802	`#if check_shape`
6	7u83	4803	`if (!eq_shape(sh(arg1), sh(arg2)) \|\| !is_integer(sh(arg1))) {`
		4804	`failer(CHSH_PLUS);`
		4805	`}`
2	7u83	4806	`#endif`
		4807	`#if !has64bits`
		4808	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	4809	`(name(arg1) != val_tag \|\| name(arg2) != val_tag\|\|`
		4810	`ov_err.err_code > 2)) {`
		4811	`return TDFcallop2(ov_err, arg1, arg2, plus_tag);`
2	7u83	4812	`}`
		4813	`#endif`
6	7u83	4814	`return me_b1(ov_err, arg1, arg2, plus_tag);`
2	7u83	4815	`}`
		4816
6	7u83	4817
		4818	`exp`
		4819	`f_pointer_test(nat_option prob, ntest nt, label dest, exp arg1, exp arg2)`
2	7u83	4820	`{`
6	7u83	4821	`if (name(sh(arg1)) == bothd) {`
		4822	`kill_exp(arg2, arg2);`
		4823	`return arg1;`
		4824	`}`
		4825	`if (name(sh(arg2)) == bothd) {`
		4826	`kill_exp(arg1, arg1);`
		4827	`return arg2;`
		4828	`}`
2	7u83	4829
		4830	`#if check_shape`
6	7u83	4831	`if (!doing_aldefs &&`
		4832	`(name(sh(arg1)) != ptrhd \|\| al1(sh(arg1)) != al1(sh(arg2)))) {`
		4833	`failer(CHSH_PTRTEST);`
		4834	`}`
2	7u83	4835	`#endif`
		4836
6	7u83	4837	`if (nt == f_comparable \|\| nt == f_not_comparable) {`
		4838	`return replace_ntest(nt, dest, arg1, arg2);`
		4839	`} else {`
		4840	`return me_q1(prob, convert_ntest[nt], dest, arg1, arg2,`
		4841	`test_tag);`
		4842	`}`
2	7u83	4843	`}`
		4844
		4845
6	7u83	4846	`exp`
		4847	`f_proc_test(nat_option prob, ntest nt, label dest, exp arg1, exp arg2)`
2	7u83	4848	`{`
6	7u83	4849	`if (name(sh(arg1)) == bothd) {`
		4850	`kill_exp(arg2, arg2);`
		4851	`return arg1;`
		4852	`}`
		4853	`if (name(sh(arg2)) == bothd) {`
		4854	`kill_exp(arg1, arg1);`
		4855	`return arg2;`
		4856	`}`
2	7u83	4857
		4858	`#if check_shape`
6	7u83	4859	`/*`
		4860	`ONLY REMOVED TEMPORARILY!`
		4861	`if (name(sh(arg1)) != prokhd \|\| name(sh(arg2)) != prokhd)`
		4862	`failer(CHSH_PROCTEST);`
		4863	`*/`
2	7u83	4864	`#endif`
		4865
6	7u83	4866	`if (nt == f_comparable \|\| nt == f_not_comparable) {`
		4867	`return replace_ntest(nt, dest, arg1, arg2);`
		4868	`} else {`
		4869	`return me_q1(prob, convert_ntest[nt], dest, arg1, arg2,`
		4870	`test_tag);`
		4871	`}`
2	7u83	4872	`}`
		4873
6	7u83	4874
		4875	`exp`
		4876	`f_profile(nat n)`
2	7u83	4877	`{`
6	7u83	4878	`return getexp(f_top, nilexp, 0, nilexp, nilexp, 0, natint(n), prof_tag);`
2	7u83	4879	`}`
		4880
6	7u83	4881
		4882	`exp`
		4883	`rem1_aux(error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	4884	`{`
		4885	`#if !has64bits`
		4886	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	4887	`(name(arg1) != val_tag \|\| name(arg2) != val_tag \|\|`
		4888	`ov_err.err_code > 2)) {`
		4889	`return TDFcallop2(ov_err, arg1, arg2, mod_tag);`
2	7u83	4890	`}`
		4891	`#endif`
6	7u83	4892	`return me_b1(ov_err, arg1, arg2, mod_tag);`
2	7u83	4893	`}`
		4894
6	7u83	4895
		4896	`exp`
		4897	`f_rem1(error_treatment div0_err, error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	4898	`{`
6	7u83	4899	`if (name(sh(arg1)) == bothd) {`
		4900	`kill_exp(arg2, arg2);`
		4901	`return arg1;`
		4902	`}`
		4903	`if (name(sh(arg2)) == bothd) {`
		4904	`kill_exp(arg1, arg1);`
		4905	`return arg2;`
		4906	`}`
2	7u83	4907
		4908	`#if check_shape`
6	7u83	4909	`if (!eq_shape(sh(arg1), sh(arg2)) \|\| !is_integer(sh(arg1))) {`
		4910	`failer(CHSH_REM1);`
		4911	`}`
2	7u83	4912	`#endif`
6	7u83	4913	`return div_rem(div0_err, ov_err, arg1, arg2, rem1_aux);`
2	7u83	4914	`}`
		4915
6	7u83	4916
		4917	`exp`
		4918	`rem0_aux(error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	4919	`{`
		4920	`#if !has64bits`
		4921	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	4922	`(name(arg1) != val_tag \|\| name(arg2) != val_tag \|\|`
		4923	`ov_err.err_code > 2)) {`
		4924	`return TDFcallop2(ov_err, arg1, arg2, rem0_tag);`
2	7u83	4925	`}`
		4926	`#endif`
		4927	`#if div0_implemented`
6	7u83	4928	`return me_b1(ov_err, arg1, arg2, rem0_tag);`
2	7u83	4929	`#else`
6	7u83	4930	`if (name(arg2) == val_tag && !isbigval(arg2)) {`
		4931	`int n = no(arg2);`
		4932	`if ((n & (n - 1)) == 0) {`
		4933	`return me_b1(ov_err, arg1, arg2, mod_tag);`
		4934	`}`
		4935	`}`
		4936	`return me_b1(ov_err, arg1, arg2, rem2_tag);`
2	7u83	4937	`#endif`
		4938	`}`
6	7u83	4939
		4940
		4941	`exp`
		4942	`f_rem0(error_treatment div0_err, error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	4943	`{`
6	7u83	4944	`if (name(sh(arg1)) == bothd) {`
		4945	`kill_exp(arg2, arg2);`
		4946	`return arg1;`
		4947	`}`
		4948	`if (name(sh(arg2)) == bothd) {`
		4949	`kill_exp(arg1, arg1);`
		4950	`return arg2;`
		4951	`}`
2	7u83	4952
		4953	`#if check_shape`
6	7u83	4954	`if (!eq_shape(sh(arg1), sh(arg2)) \|\| !is_integer(sh(arg1))) {`
		4955	`failer(CHSH_REM0);`
		4956	`}`
2	7u83	4957	`#endif`
		4958
6	7u83	4959	`return div_rem(div0_err, ov_err, arg1, arg2, rem0_aux);`
2	7u83	4960	`}`
		4961
6	7u83	4962
		4963	`exp`
		4964	`rem2_aux(error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	4965	`{`
		4966	`#if !has64bits`
		4967	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	4968	`(name(arg1) != val_tag \|\| name(arg2) != val_tag \|\|`
		4969	`ov_err.err_code > 2)) {`
		4970	`return TDFcallop2(ov_err, arg1, arg2, rem2_tag);`
2	7u83	4971	`}`
		4972	`#endif`
6	7u83	4973	`return me_b1(ov_err, arg1, arg2, rem2_tag);`
2	7u83	4974	`}`
		4975
6	7u83	4976
		4977	`exp`
		4978	`f_rem2(error_treatment div0_err, error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	4979	`{`
6	7u83	4980	`if (name(sh(arg1)) == bothd) {`
		4981	`kill_exp(arg2, arg2);`
		4982	`return arg1;`
		4983	`}`
		4984	`if (name(sh(arg2)) == bothd) {`
		4985	`kill_exp(arg1, arg1);`
		4986	`return arg2;`
		4987	`}`
2	7u83	4988
		4989	`#if check_shape`
6	7u83	4990	`if (!eq_shape(sh(arg1), sh(arg2)) \|\| !is_integer(sh(arg1))) {`
		4991	`failer(CHSH_REM2);`
		4992	`}`
2	7u83	4993	`#endif`
		4994
6	7u83	4995	`return div_rem(div0_err, ov_err, arg1, arg2, rem2_aux);`
2	7u83	4996	`}`
		4997
6	7u83	4998
2	7u83	4999	`static int silly_count = 0; /* for pathological numbers of repeats*/`
6	7u83	5000	`exp`
		5001	`f_repeat(label repeat_label_intro, exp start, exp body)`
2	7u83	5002	`{`
6	7u83	5003	`exp r = getexp(sh(body), nilexp, 0, start, crt_repeat, 0, 0, rep_tag);`
		5004	`exp labst = get_lab(repeat_label_intro);`
2	7u83	5005
6	7u83	5006	`bro(start) = labst;`
		5007	`clearlast(start);`
		5008	`setbro(son(labst), body);`
		5009	`clearlast(son(labst));`
		5010	`setbro(body, labst);`
		5011	`setlast(body);`
		5012	`setsh(labst, sh(body));`
		5013	`son(crt_repeat) = r;`
		5014	`crt_repeat = bro(crt_repeat);`
		5015	`setfather(r, labst);`
		5016	`if (silly_count == 0) {`
		5017	`default_freq = (float)(default_freq / 20.0);`
		5018	`} else {`
		5019	`silly_count--;`
		5020	`}`
		5021
		5022	`return r;`
2	7u83	5023	`}`
		5024
6	7u83	5025
		5026	`void`
		5027	`start_repeat(label repeat_label_intro)`
2	7u83	5028	`{`
6	7u83	5029	`exp labst;`
		5030	`exp def;`
		5031	`def = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, clear_tag);`
2	7u83	5032
6	7u83	5033	`/* enter this repeat on crt_repeat and repeat_list - see`
		5034	`documentation */`
		5035	`if (crt_repeat != nilexp) {`
		5036	`++no(crt_repeat);`
		5037	`}`
		5038	`repeat_list = getexp(f_top, crt_repeat, 0, nilexp, repeat_list, 1, 0,`
		5039	`0);`
		5040	`crt_repeat = repeat_list;`
		5041	`labst = getexp(f_bottom, nilexp, 0, def, nilexp, 0, 0, labst_tag);`
		5042	`if (default_freq < (float)10e10) {`
		5043	`default_freq = (float)(20.0 * default_freq);`
		5044	`} else {`
		5045	`silly_count++;`
		5046	`}`
		5047	`fno(labst) = default_freq;`
		5048	`++proc_label_count;`
		5049	`set_lab(repeat_label_intro, labst);`
		5050	`return;`
2	7u83	5051	`}`
		5052
6	7u83	5053
		5054	`exp`
		5055	`f_return(exp arg1)`
2	7u83	5056	`{`
6	7u83	5057	`if (name(sh(arg1)) == bothd) {`
		5058	`return arg1;`
		5059	`}`
		5060	`if (!reg_result(sh(arg1))) {`
		5061	`proc_struct_res = 1;`
		5062	`}`
2	7u83	5063
6	7u83	5064	`/* transformation if we are giving procedures which deliver a struct`
		5065	`result an extra pointer parameter */`
		5066	`if (redo_structfns && !reg_result(sh(arg1))) {`
		5067	`exp ret, obt;`
		5068	`exp assname, ass;`
		5069	`shape ptr_res_shape;`
		5070	`exp_list list;`
2	7u83	5071
6	7u83	5072	`if (proc_struct_result == nilexp) {`
		5073	`exp init = getexp(f_pointer(f_alignment(sh(arg1))),`
		5074	`nilexp, 0, nilexp, nilexp, 0, 0,`
		5075	`clear_tag);`
		5076	`exp iddec = getexp(sh(arg1), nilexp, 0, init, nilexp,`
		5077	`0, 0, ident_tag);`
		5078	`setparam(iddec);`
		5079	`proc_struct_result = iddec;`
		5080	`}`
		5081	`ptr_res_shape = f_pointer(f_alignment(sh(arg1)));`
		5082	`obt = getexp(ptr_res_shape, nilexp, 0, proc_struct_result,`
		5083	`pt(proc_struct_result), 0, 0, name_tag);`
		5084	`++no(proc_struct_result);`
		5085	`pt(proc_struct_result) = obt;`
2	7u83	5086
6	7u83	5087	`ret = me_u3(f_bottom, obt, res_tag);`
2	7u83	5088
6	7u83	5089	`assname = getexp(ptr_res_shape, nilexp, 0, proc_struct_result,`
		5090	`pt(proc_struct_result), 0, 0, name_tag);`
		5091	`++no(proc_struct_result);`
		5092	`pt(proc_struct_result) = assname;`
		5093	`ass = hold_check(f_assign(assname, arg1));`
		5094	`list.number = 1;`
		5095	`list.start = ass;`
		5096	`list.end = ass;`
		5097	`return f_sequence(list, ret);`
		5098	`}`
		5099	`return me_u3(f_bottom, arg1, res_tag);`
2	7u83	5100	`}`
		5101
6	7u83	5102
		5103	`exp`
		5104	`f_rotate_left(exp arg1, exp arg2)`
2	7u83	5105	`{`
6	7u83	5106	`if (name(sh(arg1)) == bothd) {`
		5107	`kill_exp(arg2, arg2);`
		5108	`return arg1;`
		5109	`}`
		5110	`if (name(sh(arg2)) == bothd) {`
		5111	`kill_exp(arg1, arg1);`
		5112	`return arg2;`
		5113	`}`
2	7u83	5114
		5115	`#if check_shape`
6	7u83	5116	`if (!is_integer(sh(arg1)) \|\| !is_integer(sh(arg2))) {`
		5117	`failer(CHSH_ROTL);`
		5118	`}`
2	7u83	5119	`#endif`
		5120	`#if !has_rotate`
6	7u83	5121	`{`
		5122	`shape sa = sh(arg1);`
		5123	`int sz = shape_size(sa);`
		5124	`shape usa = (sz == 8) ? ucharsh : (sz == 16) ?`
		5125	`uwordsh : (sz==32)?ulongsh:u64sh;`
		5126	`exp d1 = me_startid(sa, hold_check(f_change_variety(f_wrap,`
		5127	`usa, arg1)),`
		5128	`0);`
		5129	`exp d2 = me_startid(sa, arg2, 0);`
		5130	`exp d3 = me_startid(sa, hold_check(f_shift_left(f_impossible,`
		5131	`me_obtain(d1),`
		5132	`me_obtain(d2))),`
		5133	`0);`
		5134	`exp d4 = me_startid(sa, hold_check(f_minus(f_impossible,`
		5135	`me_shint(sh(arg2),`
		5136	`sz),`
		5137	`me_obtain(d2))), 0);`
		5138	`exp sr = hold_check(f_shift_right(me_obtain(d1),`
		5139	`me_obtain(d4)));`
		5140	`exp orit = hold_check(f_or(sr, me_obtain(d3)));`
		5141	`exp corit = hold_check(f_change_variety(f_wrap, sa, orit));`
		5142	`return hold_check(me_complete_id(d1,`
		5143	`hold_check(me_complete_id(d2,`
		5144	`hold_check(me_complete_id(d3,`
		5145	`hold_check(me_complete_id(d4,`
		5146	`corit))))))));`
		5147	`}`
2	7u83	5148	`#endif`
		5149
6	7u83	5150	`return me_b2(arg1, arg2, rotl_tag);`
2	7u83	5151	`}`
		5152
6	7u83	5153
		5154	`exp`
		5155	`f_rotate_right(exp arg1, exp arg2)`
2	7u83	5156	`{`
6	7u83	5157	`if (name(sh(arg1)) == bothd) {`
		5158	`kill_exp(arg2, arg2);`
		5159	`return arg1;`
		5160	`}`
		5161	`if (name(sh(arg2)) == bothd) {`
		5162	`kill_exp(arg1, arg1);`
		5163	`return arg2;`
		5164	`}`
2	7u83	5165
		5166	`#if check_shape`
6	7u83	5167	`if (!is_integer(sh(arg1)) \|\| !is_integer(sh(arg2))) {`
		5168	`failer(CHSH_ROTR);`
		5169	`}`
2	7u83	5170	`#endif`
		5171	`#if !has_rotate`
6	7u83	5172	`return f_rotate_left(arg1, hold_check(f_minus(f_impossible,`
		5173	`me_shint(sh(arg2),`
		5174	`shape_size(sh(arg1))),`
		5175	`arg2)));`
2	7u83	5176	`#endif`
		5177
6	7u83	5178	`return me_b2(arg1, arg2, rotr_tag);`
2	7u83	5179	`}`
		5180
		5181
6	7u83	5182	`exp`
		5183	`f_sequence(exp_list statements, exp result)`
2	7u83	5184	`{`
6	7u83	5185	`exp r;`
		5186	`exp h = getexp(f_bottom, result, 0, statements.start, nilexp, 0,`
		5187	`statements.number, 0);`
		5188	`exp l = statements.end;`
		5189	`clear_exp_list(statements);`
2	7u83	5190
6	7u83	5191	`/* re-organise so that sequence lists do not get too long.`
		5192	`limit to MAX_ST_LENGTH */`
		5193	`if (statements.number == 0) {`
		5194	`return result;`
		5195	`}`
		5196	`if (statements.number <= MAX_ST_LENGTH) {`
		5197	`setlast(l);`
		5198	`setbro(l, h);`
		5199	`r = getexp(sh(result), nilexp, 0, h, nilexp, 0, 0, seq_tag);`
		5200	`setfather(r, result);`
		5201	`return r;`
		5202	`} else {`
		5203	`int num_bits = statements.number / MAX_ST_LENGTH;`
		5204	`int rest = statements.number - (num_bits * MAX_ST_LENGTH);`
		5205	`exp_list work;`
		5206	`exp_list res;`
		5207	`exp t = statements.start;`
		5208	`int i, j;`
		5209	`res = new_exp_list(num_bits + 1);`
		5210	`if (rest == 0) {`
		5211	`--num_bits;`
		5212	`rest = MAX_ST_LENGTH;`
		5213	`}`
2	7u83	5214
6	7u83	5215	`for (i = 0; i < num_bits; ++i) {`
		5216	`work.start = t;`
		5217	`work.number = MAX_ST_LENGTH;`
		5218	`for (j = 0; j < (MAX_ST_LENGTH - 1); ++j) {`
		5219	`t = bro(t);`
		5220	`}`
		5221	`work.end = t;`
		5222	`t = bro(t);`
		5223	`res = add_exp_list(res, hold_check(f_sequence(work,`
		5224	`f_make_top())), i);`
		5225	`}`
2	7u83	5226
6	7u83	5227	`work.start = t;`
		5228	`work.end = l;`
		5229	`work.number = rest;`
		5230	`res = add_exp_list(res, hold_check(f_sequence(work,`
		5231	`f_make_top())),`
		5232	`num_bits);`
		5233	`return f_sequence(res, result);`
		5234	`}`
2	7u83	5235	`}`
		5236
6	7u83	5237
		5238	`exp`
		5239	`f_shape_offset(shape s)`
2	7u83	5240	`{`
6	7u83	5241	`return getexp(f_offset(f_alignment(s), long_to_al(1)), nilexp, 0,`
		5242	`nilexp, nilexp, 0, shape_size(s), val_tag);`
2	7u83	5243	`}`
		5244
6	7u83	5245
		5246	`exp`
		5247	`f_shift_left(error_treatment ov_err, exp arg1, exp arg2)`
2	7u83	5248	`{`
6	7u83	5249	`if (name(sh(arg1)) == bothd) {`
		5250	`kill_exp(arg2, arg2);`
		5251	`return arg1;`
		5252	`}`
		5253	`if (name(sh(arg2)) == bothd) {`
		5254	`kill_exp(arg1, arg1);`
		5255	`return arg2;`
		5256	`}`
2	7u83	5257
		5258	`#if check_shape`
6	7u83	5259	`if (!is_integer(sh(arg1)) \|\| !is_integer(sh(arg2))) {`
		5260	`failer(CHSH_SHL);`
		5261	`}`
2	7u83	5262	`#endif`
		5263	`#if !has64bits`
		5264	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	5265	`(name(arg1) != val_tag \|\| name(arg2) != val_tag \|\|`
		5266	`ov_err.err_code > 2)) {`
		5267	`arg2 = hold_check(f_change_variety(ov_err, ulongsh, arg2));`
		5268	`return TDFcallop2(ov_err, arg1, arg2, shl_tag);`
2	7u83	5269	`}`
		5270	`#endif`
		5271
6	7u83	5272	`if (ov_err.err_code == 4) {`
		5273	`exp d1 = me_startid(f_top, arg1, 0);`
		5274	`exp d2 = me_startid(f_top, arg2, 0);`
		5275	`exp d3 = me_startid(f_top, hold_check(f_shift_left(f_impossible,`
		5276	`me_obtain(d1),`
		5277	`me_obtain(d2))),`
		5278	`0);`
		5279	`exp_list el;`
		5280	`exp right = hold_check(f_shift_right(me_obtain(d3),`
		5281	`me_obtain(d2)));`
		5282	`exp test = me_q1(no_nat_option, f_equal, ov_err.jmp_dest, right,`
		5283	`me_obtain(d1), test_tag);`
		5284	`el = new_exp_list(1);`
		5285	`el = add_exp_list(el, test, 1);`
		5286	`return me_complete_id(d1, me_complete_id(d2, me_complete_id(d3,`
		5287	`f_sequence(el, me_obtain(d3)))));`
		5288	`} else if (ov_err.err_code > 4) {`
		5289	`exp d1 = me_startid(f_top, arg1, 0);`
		5290	`exp d2 = me_startid(f_top, arg2, 0);`
		5291	`exp d3 = me_startid(f_top, hold_check(f_shift_left(f_impossible,`
		5292	`me_obtain(d1),`
		5293	`me_obtain(d2))), 0);`
		5294	`exp_list el;`
		5295	`exp right = hold_check(f_shift_right(me_obtain(d3),`
		5296	`me_obtain(d2)));`
		5297	`exp trp = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0,`
		5298	`f_overflow, trap_tag);`
		5299	`exp hldr = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, 0);`
		5300	`exp lb = getexp(f_top, nilexp, 0, hldr, nilexp, 0, 0,`
		5301	`labst_tag);`
		5302	`exp test = me_q1(no_nat_option, f_equal, &lb, right,`
		5303	`me_obtain(d1), test_tag);`
		5304	`el = new_exp_list(1);`
		5305	`el = add_exp_list(el, test, 1);`
		5306	`return me_complete_id(d1, me_complete_id(d2, me_complete_id(d3,`
		5307	`f_conditional(&lb, f_sequence(el,`
		5308	`me_obtain(d3)), trp))));`
		5309	`}`
2	7u83	5310
6	7u83	5311	`return me_b1(ov_err, arg1, arg2, shl_tag);`
2	7u83	5312	`}`
		5313
6	7u83	5314
		5315	`exp`
		5316	`f_shift_right(exp arg1, exp arg2)`
2	7u83	5317	`{`
6	7u83	5318	`if (name(sh(arg1)) == bothd) {`
		5319	`kill_exp(arg2, arg2);`
		5320	`return arg1;`
		5321	`}`
		5322	`if (name(sh(arg2)) == bothd) {`
		5323	`kill_exp(arg1, arg1);`
		5324	`return arg2;`
		5325	`}`
2	7u83	5326
		5327	`#if check_shape`
6	7u83	5328	`if (!is_integer(sh(arg1)) \|\| !is_integer(sh(arg2))) {`
		5329	`failer(CHSH_SHR);`
		5330	`}`
2	7u83	5331	`#endif`
		5332	`#if !has64bits`
		5333	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	5334	`(name(arg1) != val_tag \|\| name(arg2) != val_tag)) {`
2	7u83	5335	`error_treatment ov_err;`
		5336	`ov_err = f_wrap;`
6	7u83	5337	`arg2 = hold_check(f_change_variety(ov_err, ulongsh, arg2));`
		5338	`return TDFcallop2(ov_err, arg1, arg2, shr_tag);`
2	7u83	5339	`}`
		5340	`#endif`
6	7u83	5341	`return me_b2(arg1, arg2, shr_tag);`
2	7u83	5342	`}`
		5343
6	7u83	5344
		5345	`exp`
		5346	`f_subtract_ptrs(exp arg1, exp arg2)`
2	7u83	5347	`{`
6	7u83	5348	`if (name(sh(arg1)) == bothd) {`
		5349	`kill_exp(arg2, arg2);`
		5350	`return arg1;`
		5351	`}`
		5352	`if (name(sh(arg2)) == bothd) {`
		5353	`kill_exp(arg1, arg1);`
		5354	`return arg2;`
		5355	`}`
		5356	`return me_b3(f_offset(al1_of(sh(arg2)), al1_of(sh(arg1))), arg1, arg2,`
		5357	`minptr_tag);`
2	7u83	5358	`}`
		5359
6	7u83	5360
		5361	`exp`
		5362	`f_variable(access_option acc, tag name_intro, exp init, exp body)`
2	7u83	5363	`{`
6	7u83	5364	`exp i = get_tag(name_intro);`
		5365	`exp d = son(i);`
		5366	`UNUSED(acc);`
		5367	`UNUSED(init);`
		5368	`setsh(i, sh(body));`
		5369	`setbro(d, body);`
		5370	`clearlast(d);`
		5371	`setfather(i, body);`
2	7u83	5372	`#ifdef NEWDIAGS`
6	7u83	5373	`if (doing_mark_scope) {`
		5374	`/* must be reading old diags */`
		5375	`correct_mark_scope(i);`
		5376	`}`
2	7u83	5377	`#endif`
6	7u83	5378	`return i;`
2	7u83	5379	`}`
		5380
6	7u83	5381
		5382	`void`
		5383	`start_variable(access_option acc, tag name_intro, exp init)`
2	7u83	5384	`{`
6	7u83	5385	`exp i = get_tag(name_intro);`
		5386	`if (i == nilexp \|\| son(i) != i) {`
		5387	`i = getexp(f_bottom, nilexp, 0, init, nilexp, 0, 0, ident_tag);`
		5388	`} else {`
		5389	`/* could have been already used in env_offset */`
		5390	`son(i) = init;`
		5391	`}`
2	7u83	5392
6	7u83	5393	`setvar(i);`
		5394	`if (acc & (f_visible \| f_long_jump_access)) {`
		5395	`setvis(i);`
		5396	`setenvoff(i);`
		5397	`} else if ((acc & f_no_other_read) && (acc & f_no_other_write)) {`
		5398	`setcaonly(i);`
		5399	`}`
		5400	`set_tag(name_intro, i);`
		5401
		5402	`return;`
2	7u83	5403	`}`
		5404
6	7u83	5405
		5406	`exp`
		5407	`f_xor(exp arg1, exp arg2)`
2	7u83	5408	`{`
6	7u83	5409	`if (name(sh(arg1)) == bothd) {`
		5410	`kill_exp(arg2, arg2);`
		5411	`return arg1;`
		5412	`}`
		5413	`if (name(sh(arg2)) == bothd) {`
		5414	`kill_exp(arg1, arg1);`
		5415	`return arg2;`
		5416	`}`
2	7u83	5417
		5418	`#if check_shape`
6	7u83	5419	`if (!eq_shape(sh(arg1), sh(arg2)) \|\| !is_integer(sh(arg1))) {`
		5420	`failer(CHSH_XOR);`
		5421	`}`
2	7u83	5422	`#endif`
		5423	`#if !has64bits`
		5424	`if (name(sh(arg1)) >= s64hd &&`
6	7u83	5425	`(name(arg1) != val_tag \|\| name(arg2) != val_tag)) {`
		5426	`return TDFcallop3(arg1, arg2, xor_tag);`
2	7u83	5427	`}`
		5428	`#endif`
6	7u83	5429	`return me_b2(arg1, arg2, xor_tag);`
2	7u83	5430	`}`
		5431
6	7u83	5432
		5433	`void`
		5434	`init_exp(void)`
2	7u83	5435	`{`
6	7u83	5436	`freelist = nilexp;`
		5437	`exps_left = 0;`
		5438	`crt_labno = 0;`
		5439	`global_case = getexp(f_bottom, nilexp, 0, nilexp, nilexp, 0, 0, 0);`
		5440	`in_initial_value = 0;`
		5441	`initial_value_pp.proc_struct_result = nilexp;`
		5442	`initial_value_pp.has_alloca = 0;`
		5443	`initial_value_pp.proc_is_recursive = 0;`
		5444	`initial_value_pp.uses_crt_env = 0;`
		5445	`initial_value_pp.has_setjmp = 0;`
		5446	`initial_value_pp.uses_loc_address = 0;`
		5447	`initial_value_pp.proc_label_count = 0;`
		5448	`initial_value_pp.proc_struct_res = 0;`
		5449	`initial_value_pp.default_freq = default_freq;`
		5450	`initial_value_pp.proc_externs = 0;`
		5451	`initial_value_pp.in_proc_def = 0;`
		5452	`initial_value_pp.pushed = (proc_props*)0;`
		5453	`initial_value_pp.rep_make_proc = 0;`
		5454	`return;`
2	7u83	5455	`}`
		5456
6	7u83	5457
2	7u83	5458	`exp f_dummy_exp;`
		5459
6	7u83	5460	`exp`
		5461	`f_return_to_label(exp e)`
2	7u83	5462	`{`
		5463	`has_lv = 1;`
		5464	`return me_u3(f_bottom, e, return_to_label_tag);`
		5465	`}`
		5466
		5467
6	7u83	5468	`nat`
		5469	`f_computed_nat(exp arg)`
2	7u83	5470	`{`
6	7u83	5471	`nat res;`
		5472	`if (name(arg) == val_tag) {`
		5473	`if (extra_checks && constovf(arg)) {`
		5474	`failer(ILLNAT);`
		5475	`}`
2	7u83	5476
6	7u83	5477	`if (!isbigval(arg)) {`
		5478	`nat_issmall(res) = 1;`
		5479	`natint(res) = no(arg);`
		5480	`return res;`
		5481	`} else {`
		5482	`nat_issmall(res) = 0;`
		5483	`natbig(res) = no(arg);`
		5484	`return res;`
		5485	`}`
		5486	`}`
2	7u83	5487
6	7u83	5488	`if (name(arg) == name_tag && !isvar(son(arg))) {`
		5489	`res = f_computed_nat(son(son(arg)));`
		5490	`kill_exp(arg, arg);`
		5491	`return res;`
		5492	`}`
2	7u83	5493
6	7u83	5494	`failer(ILLCOMPNAT);`
		5495	`nat_issmall(res) = 1;`
		5496	`natint(res) = 1;`
		5497	`return res;`
2	7u83	5498	`}`
		5499
6	7u83	5500
		5501	`nat`
		5502	`f_make_nat(tdfint n)`
2	7u83	5503	`{`
6	7u83	5504	`return n;`
2	7u83	5505	`}`
		5506
6	7u83	5507
		5508	`void`
		5509	`init_nat(void)`
2	7u83	5510	`{`
6	7u83	5511	`return;`
2	7u83	5512	`}`
		5513
6	7u83	5514
2	7u83	5515	`nat f_dummy_nat;`
		5516
6	7u83	5517	`void`
		5518	`init_ntest(void)`
2	7u83	5519	`{`
6	7u83	5520	`return;`
2	7u83	5521	`}`
		5522
6	7u83	5523
		5524	`void`
		5525	`init_otagexp(void)`
2	7u83	5526	`{`
		5527	`return;`
		5528	`}`
		5529
6	7u83	5530
		5531	`void`
		5532	`init_procprops(void)`
2	7u83	5533	`{`
		5534	`return;`
		5535	`}`
		5536
		5537
		5538	`ntest f_dummy_ntest;`
		5539
6	7u83	5540	`void`
		5541	`init_rounding_mode(void)`
2	7u83	5542	`{`
6	7u83	5543	`return;`
2	7u83	5544	`}`
		5545
6	7u83	5546
2	7u83	5547	`rounding_mode f_dummy_rounding_mode;`
		5548
6	7u83	5549	`shape`
		5550	`f_bitfield(bitfield_variety bf_var)`
2	7u83	5551	`{`
6	7u83	5552	`return getshape(bf_var.has_sign, const_al1, const_al1, BF_ALIGN,`
		5553	`bf_var.bits, bitfhd);`
2	7u83	5554	`}`
		5555
6	7u83	5556
		5557	`shape`
		5558	`f_compound(exp off)`
2	7u83	5559	`{`
6	7u83	5560	`int sz;`
		5561	`if (name(off) ==val_tag) {`
		5562	`sz = no(off);`
		5563	`} else {`
		5564	`failer(ILLCPDOFFSET);`
		5565	`sz = 0;`
		5566	`}`
		5567	`return getshape(0, const_al1, const_al1, al1_of(sh(off)), sz, cpdhd);`
2	7u83	5568	`}`
		5569
6	7u83	5570
		5571	`shape`
		5572	`f_floating(floating_variety fv)`
2	7u83	5573	`{`
6	7u83	5574	`switch (fv)`
		5575	`{`
		5576	`case shrealfv:`
		5577	`return shrealsh;`
		5578	`case realfv:`
		5579	`return realsh;`
		5580	`case doublefv:`
		5581	`return doublesh;`
		5582	`case shcomplexfv:`
		5583	`return shcomplexsh;`
		5584	`case complexfv:`
		5585	`return complexsh;`
		5586	`case complexdoublefv:`
		5587	`return complexdoublesh;`
		5588	`}`
		5589	`return realsh;`
2	7u83	5590	`}`
		5591
6	7u83	5592
		5593	`shape`
		5594	`f_integer(variety var)`
2	7u83	5595	`{`
6	7u83	5596	`return var;`
2	7u83	5597	`}`
		5598
6	7u83	5599
		5600	`shape`
		5601	`f_nof(nat n, shape s)`
2	7u83	5602	`{`
6	7u83	5603	`if (doing_aldefs) {`
		5604	`return s;`
		5605	`} else {`
		5606	`int al = shape_align(s);`
		5607	`int sz = rounder(shape_size(s), al);`
		5608	`int nm = (int)name(s);`
		5609	`int nofsz = natint(n)*sz;`
		5610	`shape res;`
		5611	`if (name(s) == nofhd) {`
		5612	`nm = ptno(s);`
		5613	`}`
2	7u83	5614	`#if !has64bits`
6	7u83	5615	`if (!nat_issmall(n)) {`
		5616	`failer(TOO_BIG_A_VECTOR);`
		5617	`}`
2	7u83	5618	`#endif`
6	7u83	5619	`if (name(s) == tophd) {`
		5620	`/* pathological - make it nof(0, char) */`
		5621	`res = getshape(0, const_al1, const_al1,`
		5622	`align_of(ucharsh), 0, nofhd);`
		5623	`} else if (al == 1) {`
		5624	`if ((sz & (sz - 1)) != 0 && nofsz > BF_STORE_UNIT) {`
		5625	`IGNORE fprintf(stderr, "Warning: Bitfields of nof cannot all be variety enclosed \n");`
		5626	`}`
		5627	`if ((sz & (sz - 1)) == 0 \|\| nofsz > BF_STORE_UNIT) {`
		5628	`shape news = containedshape(sz, 1);`
		5629	`int nsz = shape_align(news);`
		5630	`int newn = rounder(nofsz, nsz);`
		5631	`res = getshape(0, const_al1, const_al1,`
		5632	`align_of(news), newn, nofhd);`
		5633	`} else {`
		5634	`shape news = containedshape(nofsz, 1);`
		5635	`res = getshape(0, const_al1, const_al1,`
		5636	`align_of(news), shape_size(news),`
		5637	`cpdhd);`
		5638	`}`
		5639	`} else {`
		5640	`res = getshape(0, const_al1, const_al1, align_of(s),`
		5641	`nofsz, nofhd);`
		5642	`}`
2	7u83	5643
6	7u83	5644	`ptno(res) = nm; /* set the pt field of the shape to the`
		5645	`shapemacs.h hd identifier of the shape */`
		5646	`return res;`
2	7u83	5647	`}`
6	7u83	5648	`}`
2	7u83	5649
		5650
6	7u83	5651	`shape`
		5652	`f_offset(alignment arg1, alignment arg2)`
2	7u83	5653	`{`
6	7u83	5654	`/* use values pre-computed by init since we never alter shapes */`
		5655	`if (arg1->al.al_n != 1 \|\| arg2->al.al_n != 1 \|\| arg1->al.sh_hd != 0 \|\|`
		5656	`arg2->al.sh_hd != 0 \|\| arg1->al.al_val.al_frame != 0 \|\|`
		5657	`arg2->al.al_val.al_frame != 0) {`
		5658	`return getshape(0, arg1, arg2, OFFSET_ALIGN, OFFSET_SZ,`
		5659	`offsethd);`
		5660	`}`
2	7u83	5661
6	7u83	5662	`/* use values pre-computed by init since we never alter shapes */`
		5663	`switch (arg1->al.al_val.al) {`
		5664	`case 512:`
		5665	`switch (arg2->al.al_val.al) {`
		5666	`case 512:`
		5667	`return f_off512_512;`
		5668	`case 64:`
		5669	`return f_off512_64;`
		5670	`case 32:`
		5671	`return f_off512_32;`
		5672	`case 16:`
		5673	`return f_off512_16;`
		5674	`case 8:`
		5675	`return f_off512_8;`
		5676	`case 1:`
		5677	`return f_off512_1;`
		5678	`default:`
		5679	`failer(ILLOFF2);`
		5680	`return f_off64_8;`
		5681	`}`
		5682	`case 64:`
		5683	`switch (arg2->al.al_val.al) {`
		5684	`case 64:`
		5685	`return f_off64_64;`
		5686	`case 32:`
		5687	`return f_off64_32;`
		5688	`case 16:`
		5689	`return f_off64_16;`
		5690	`case 8:`
		5691	`return f_off64_8;`
		5692	`case 1:`
		5693	`return f_off64_1;`
		5694	`default:`
		5695	`failer(ILLOFF2);`
		5696	`return f_off64_8;`
		5697	`}`
		5698	`case 32:`
		5699	`switch (arg2->al.al_val.al) {`
		5700	`case 32:`
		5701	`return f_off32_32;`
		5702	`case 16:`
		5703	`return f_off32_16;`
		5704	`case 8:`
		5705	`return f_off32_8;`
		5706	`case 1:`
		5707	`return f_off32_1;`
		5708	`default:`
		5709	`failer(ILLOFF2);`
		5710	`return f_off32_8;`
		5711	`}`
		5712	`case 16:`
		5713	`switch (arg2->al.al_val.al) {`
		5714	`case 16:`
		5715	`return f_off16_16;`
		5716	`case 8:`
		5717	`return f_off16_8;`
		5718	`case 1:`
		5719	`return f_off16_1;`
		5720	`default:`
		5721	`failer(ILLOFF2);`
		5722	`return f_off16_8;`
		5723	`}`
		5724	`case 8:`
		5725	`switch (arg2->al.al_val.al) {`
		5726	`case 8:`
		5727	`return f_off8_8;`
		5728	`case 1:`
		5729	`return f_off8_1;`
		5730	`default:`
		5731	`failer(ILLOFF2);`
		5732	`return f_off8_8;`
		5733	`}`
		5734	`case 1:`
		5735	`switch (arg2->al.al_val.al) {`
		5736	`case 1:`
		5737	`return f_off1_1;`
		5738	`default:`
		5739	`failer(ILLOFF2);`
		5740	`return f_off1_1;`
		5741	`}`
		5742	`default:`
		5743	`failer(ILLOFF1);`
		5744	`return f_off8_8;`
		5745	`}`
2	7u83	5746	`}`
		5747
6	7u83	5748
2	7u83	5749	`static shape frame_ptrs[32];`
		5750
6	7u83	5751	`static struct SAL {`
		5752	`alignment al;`
		5753	`shape ptr_sh;`
		5754	`struct SAL *rest;`
		5755	`} *cache_pashs;`
2	7u83	5756
6	7u83	5757	`shape`
		5758	`f_pointer(alignment arg)`
2	7u83	5759	`{`
6	7u83	5760	`/* use values pre-computed by init since we never alter shapes */`
		5761	`int af = arg->al.al_val.al_frame;`
		5762	`if (arg->al.al_n != 1 && af == 0) {`
		5763	`return getshape(0, arg, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);`
2	7u83	5764	`}`
6	7u83	5765	`if (af != 0) {`
		5766	`if (frame_ptrs[af] == (shape)0) {`
		5767	`frame_ptrs[af] = getshape(0, arg, const_al1, PTR_ALIGN,`
		5768	`PTR_SZ, ptrhd);`
		5769	`}`
		5770	`return frame_ptrs[af];`
2	7u83	5771	`}`
6	7u83	5772	`if (arg->al.sh_hd != 0) {`
		5773	`struct SAL *c = cache_pashs;`
		5774	`shape res;`
		5775	`while (c != (struct SAL*)0) {`
		5776	`if (arg == c->al) return c->ptr_sh;`
		5777	`c = c->rest;`
		5778	`}`
		5779	`res = getshape(0, arg, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);`
		5780	`c = (struct SAL*)xmalloc(sizeof(struct SAL));`
		5781	`c->al = arg; c->ptr_sh = res; c->rest = cache_pashs;`
		5782	`cache_pashs = c;`
		5783	`return res;`
		5784	`}`
2	7u83	5785
6	7u83	5786	`switch (arg->al.al_val.al)`
		5787	`{`
		5788	`case 1: return f_ptr1;`
		5789	`case 8: return f_ptr8;`
		5790	`case 16: return f_ptr16;`
		5791	`case 32: return f_ptr32;`
		5792	`case 64: return f_ptr64;`
		5793	`default: failer(ILLALIGN); return f_ptr8;`
		5794	`};`
2	7u83	5795	`}`
		5796
6	7u83	5797
2	7u83	5798	`shape f_proc;`
		5799
6	7u83	5800	`void`
		5801	`init_shape(void)`
2	7u83	5802	`{`
6	7u83	5803	`/* pre-compute values for use in f_pointer and f_offset */`
2	7u83	5804
6	7u83	5805	`int i;`
		5806	`for (i = 0; i < 32; i++) {`
		5807	`frame_ptrs[i] = (shape)0;`
		5808	`}`
		5809	`cache_pashs = (struct SAL *)0;`
2	7u83	5810
6	7u83	5811	`f_bottom = getshape(0, const_al1, const_al1, const_al1, 0, bothd);`
2	7u83	5812
6	7u83	5813	`f_top = getshape(0, const_al1, const_al1, TOP_ALIGN, TOP_SZ, tophd);`
2	7u83	5814
6	7u83	5815	`f_proc = getshape(0, const_al1, const_al1, PROC_ALIGN, PROC_SZ, prokhd);`
2	7u83	5816
6	7u83	5817	`f_ptr1 = getshape(0, const_al1, const_al1, PTR_ALIGN, PTRBIT_SZ, ptrhd);`
2	7u83	5818
6	7u83	5819	`f_ptr8 = getshape(0, const_al8, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);`
		5820	`f_local_label_value = f_ptr8;`
2	7u83	5821
6	7u83	5822	`f_ptr16 = getshape(0, const_al16, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);`
2	7u83	5823
6	7u83	5824	`f_ptr32 = getshape(0, const_al32, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);`
2	7u83	5825
6	7u83	5826	`f_ptr64 = getshape(0, const_al64, const_al1, PTR_ALIGN, PTR_SZ, ptrhd);`
2	7u83	5827
6	7u83	5828	`f_off1_1 = getshape(1, const_al1, const_al1, OFFSET_ALIGN, OFFSET_SZ,`
		5829	`offsethd);`
2	7u83	5830
6	7u83	5831	`f_off0_0 = getshape(1, const_al1, const_al1, OFFSET_ALIGN, OFFSET_SZ,`
		5832	`offsethd);`
2	7u83	5833
6	7u83	5834	`f_off8_8 = getshape(1, const_al8, const_al8, OFFSET_ALIGN, OFFSET_SZ,`
		5835	`offsethd);`
2	7u83	5836
6	7u83	5837	`f_off8_1 = getshape(1, const_al8, const_al1, OFFSET_ALIGN, OFFSET_SZ,`
		5838	`offsethd);`
2	7u83	5839
6	7u83	5840	`f_off16_16 = getshape(1, const_al16, const_al16, OFFSET_ALIGN,`
		5841	`OFFSET_SZ, offsethd);`
2	7u83	5842
6	7u83	5843	`f_off16_8 = getshape(1, const_al16, const_al8, OFFSET_ALIGN, OFFSET_SZ,`
		5844	`offsethd);`
2	7u83	5845
6	7u83	5846	`f_off16_1 = getshape(1, const_al16, const_al1, OFFSET_ALIGN, OFFSET_SZ,`
		5847	`offsethd);`
2	7u83	5848
6	7u83	5849	`f_off32_32 = getshape(1, const_al32, const_al32, OFFSET_ALIGN,`
		5850	`OFFSET_SZ, offsethd);`
2	7u83	5851
6	7u83	5852	`f_off32_16 = getshape(1, const_al32, const_al16, OFFSET_ALIGN,`
		5853	`OFFSET_SZ, offsethd);`
2	7u83	5854
6	7u83	5855	`f_off32_8 = getshape(1, const_al32, const_al8, OFFSET_ALIGN, OFFSET_SZ,`
		5856	`offsethd);`
2	7u83	5857
6	7u83	5858	`f_off32_1 = getshape(1, const_al32, const_al1, OFFSET_ALIGN, OFFSET_SZ,`
		5859	`offsethd);`
2	7u83	5860
6	7u83	5861	`f_off64_64 = getshape(1, const_al64, const_al64, OFFSET_ALIGN,`
		5862	`OFFSET_SZ, offsethd);`
2	7u83	5863
6	7u83	5864	`f_off64_32 = getshape(1, const_al64, const_al32, OFFSET_ALIGN,`
		5865	`OFFSET_SZ, offsethd);`
2	7u83	5866
6	7u83	5867	`f_off64_16 = getshape(1, const_al64, const_al16, OFFSET_ALIGN,`
		5868	`OFFSET_SZ, offsethd);`
2	7u83	5869
6	7u83	5870	`f_off64_8 = getshape(1, const_al64, const_al8, OFFSET_ALIGN, OFFSET_SZ,`
		5871	`offsethd);`
2	7u83	5872
6	7u83	5873	`f_off64_1 = getshape(1, const_al64, const_al1, OFFSET_ALIGN, OFFSET_SZ,`
		5874	`offsethd);`
2	7u83	5875
6	7u83	5876	`f_off512_512 = getshape(1, const_al512, const_al512, OFFSET_ALIGN,`
		5877	`OFFSET_SZ, offsethd);`
2	7u83	5878
6	7u83	5879	`f_off512_64 = getshape(1, const_al512, const_al64, OFFSET_ALIGN,`
		5880	`OFFSET_SZ, offsethd);`
2	7u83	5881
6	7u83	5882	`f_off512_32 = getshape(1, const_al512, const_al32, OFFSET_ALIGN,`
		5883	`OFFSET_SZ, offsethd);`
2	7u83	5884
6	7u83	5885	`f_off512_16 = getshape(1, const_al512, const_al16, OFFSET_ALIGN,`
		5886	`OFFSET_SZ, offsethd);`
2	7u83	5887
6	7u83	5888	`f_off512_8 = getshape(1, const_al512, const_al8, OFFSET_ALIGN,`
		5889	`OFFSET_SZ, offsethd);`
2	7u83	5890
6	7u83	5891	`f_off512_1 = getshape(1, const_al512, const_al1, OFFSET_ALIGN,`
		5892	`OFFSET_SZ, offsethd);`
2	7u83	5893
6	7u83	5894	`return;`
2	7u83	5895	`}`
		5896
6	7u83	5897
2	7u83	5898	`shape f_dummy_shape;`
		5899
6	7u83	5900	`signed_nat`
		5901	`f_computed_signed_nat(exp arg)`
2	7u83	5902	`{`
6	7u83	5903	`signed_nat res;`
		5904	`if (name(arg) == val_tag) {`
		5905	`if (extra_checks && constovf(arg)) {`
		5906	`failer(ILLNAT);`
		5907	`}`
2	7u83	5908
6	7u83	5909	`if (!isbigval(arg)) {`
		5910	`snat_issmall(res) = 1;`
		5911	`if (!is_signed(sh(arg))) {`
		5912	`snatneg(res) = 0;`
		5913	`snatint(res) = no(arg);`
		5914	`} else {`
		5915	`if (no(arg) < 0) {`
		5916	`snatneg(res) = 1;`
		5917	`snatint(res) = -no(arg);`
		5918	`} else {`
		5919	`snatneg(res) = 0;`
		5920	`snatint(res) = no(arg);`
		5921	`}`
		5922	`}`
		5923	`return res;`
		5924	`} else {`
		5925	`snat_issmall(res) = 0;`
		5926	`snatneg(res) = (bool)(flptnos[no(arg)].sign == -1);`
		5927	`flptnos[no(arg)].sign = 1;`
		5928	`snatint(res) = no(arg);`
		5929	`return res;`
		5930	`}`
		5931	`}`
2	7u83	5932
6	7u83	5933	`if (name(arg) == name_tag && !isvar(son(arg))) {`
		5934	`res = f_computed_signed_nat(son(son(arg)));`
		5935	`kill_exp(arg, arg);`
		5936	`return res;`
		5937	`}`
2	7u83	5938
6	7u83	5939	`failer(ILLCOMPSNAT);`
		5940	`snat_issmall(res) = 1;`
		5941	`snatneg(res) = 0;`
		5942	`snatint(res) = 1;`
		5943	`return res;`
2	7u83	5944	`}`
		5945
6	7u83	5946
		5947	`signed_nat`
		5948	`f_snat_from_nat(bool neg, nat n)`
2	7u83	5949	`{`
6	7u83	5950	`signed_nat res;`
2	7u83	5951
6	7u83	5952	`if (snat_issmall(n)) {`
		5953	`snatneg(res) = (bool)((natint(n) == 0) ? 0 : neg);`
		5954	`snat_issmall(res) = 1;`
		5955	`snatint(res) = natint(n);`
		5956	`return res;`
		5957	`}`
2	7u83	5958
6	7u83	5959	`snat_issmall(res) = 0;`
		5960	`snatbig(res) = natbig(n);`
		5961	`snatneg(res) = neg;`
		5962	`return res;`
2	7u83	5963	`}`
		5964
6	7u83	5965
		5966	`signed_nat`
		5967	`f_make_signed_nat(tdfbool neg, tdfint n)`
2	7u83	5968	`{`
6	7u83	5969	`return f_snat_from_nat(neg, n);`
2	7u83	5970	`}`
		5971
6	7u83	5972
		5973	`void`
		5974	`init_signed_nat(void)`
2	7u83	5975	`{`
6	7u83	5976	`return;`
2	7u83	5977	`}`
		5978
6	7u83	5979
2	7u83	5980	`signed_nat f_dummy_signed_nat;`
		5981
		5982	`string f_dummy_string;`
		5983
6	7u83	5984	`void`
		5985	`init_string(void)`
2	7u83	5986	`{`
		5987	`return;`
		5988	`}`
		5989
6	7u83	5990
		5991	`string`
		5992	`f_concat_string(string a1, string a2)`
2	7u83	5993	`{`
		5994	`int i;`
6	7u83	5995	`string res;`
2	7u83	5996	`if (a1.size != a2.size) {`
		5997	`failer("Concatenated strings have different unit size");`
		5998	`}`
		5999	`res.number = a1.number + a2.number;`
		6000	`res.size = a1.size;`
6	7u83	6001	`if (res.size <= 8) {`
		6002	`res.ints.chars = (char *)xcalloc(res.number + 1, sizeof(char));`
		6003	`for (i = 0; i < a1.number; i++) {`
2	7u83	6004	`res.ints.chars[i] = a1.ints.chars[i];`
6	7u83	6005	`}`
		6006	`for (i = 0; i < a2.number; i++) {`
		6007	`res.ints.chars[i + a1.number] = a2.ints.chars[i];`
		6008	`}`
		6009	`res.ints.chars[res.number] = 0;`
		6010	`} else if (res.size <= 16) {`
		6011	`res.ints.shorts = (short *)xcalloc(res.number + 1,`
		6012	`sizeof(short));`
		6013	`for (i = 0; i < a1.number; i++) {`
2	7u83	6014	`res.ints.shorts[i] = a1.ints.shorts[i];`
6	7u83	6015	`}`
		6016	`for (i = 0; i < a2.number; i++) {`
		6017	`res.ints.shorts[i + a1.number] = a2.ints.shorts[i];`
		6018	`}`
		6019	`res.ints.shorts[res.number] =0;`
		6020	`} else {`
		6021	`res.ints.longs = (int *)xcalloc(res.number + 1, sizeof(int));`
		6022	`for (i = 0; i < a1.number; i++) {`
2	7u83	6023	`res.ints.longs[i] = a1.ints.longs[i];`
6	7u83	6024	`}`
		6025	`for (i = 0; i < a2.number; i++) {`
		6026	`res.ints.longs[i + a1.number] = a2.ints.longs[i];`
		6027	`}`
		6028	`res.ints.longs[res.number] =0;`
2	7u83	6029	`}`
		6030	`return res;`
		6031	`}`
		6032
6	7u83	6033
		6034	`string`
		6035	`f_make_string(tdfstring s)`
2	7u83	6036	`{`
		6037	`return s;`
		6038	`}`
		6039
6	7u83	6040
		6041	`tagshacc`
		6042	`f_make_tagshacc(shape sha, access_option visible, tag tg_intro)`
2	7u83	6043	`{`
6	7u83	6044	`tagshacc res;`
		6045	`res.sha = sha;`
		6046	`res.visible = visible;`
		6047	`res.tg = tg_intro;`
		6048	`return res;`
2	7u83	6049	`}`
		6050
6	7u83	6051
		6052	`void`
		6053	`init_tagshacc(void)`
2	7u83	6054	`{`
6	7u83	6055	`return;`
2	7u83	6056	`}`
		6057
6	7u83	6058
2	7u83	6059	`transfer_mode f_dummy_transfer_mode;`
		6060
6	7u83	6061	`transfer_mode`
		6062	`f_add_modes(transfer_mode md1, transfer_mode md2)`
2	7u83	6063	`{`
6	7u83	6064	`return md1 \| md2;`
2	7u83	6065	`}`
		6066
		6067
6	7u83	6068	`version`
		6069	`f_user_info(tdfident t)`
2	7u83	6070	`{`
6	7u83	6071	`version res;`
		6072	`UNUSED(t);`
		6073	`res.major_version = MAJOR_VERSION;`
		6074	`res.minor_version = MINOR_VERSION;`
		6075	`return res;`
2	7u83	6076	`}`
		6077
		6078
6	7u83	6079	`variety`
		6080	`f_var_limits(signed_nat lower_bound, signed_nat upper_bound)`
2	7u83	6081	`{`
6	7u83	6082	`unsigned int h;`
		6083	`unsigned int l;`
2	7u83	6084
6	7u83	6085	`if (!snat_issmall(lower_bound) \|\| !snat_issmall(upper_bound)) {`
		6086	`if (snatneg(lower_bound)) {`
		6087	`return s64sh;`
		6088	`} else {`
		6089	`return u64sh;`
		6090	`}`
		6091	`}`
2	7u83	6092
6	7u83	6093	`/* normalise the varieties to use only the six standard ones */`
		6094	`l = (unsigned int)(snatint(lower_bound));`
		6095	`/* these assume the length of unsigned int equals int */`
		6096	`h = (unsigned int)(snatint(upper_bound));`
2	7u83	6097
6	7u83	6098	`if (!snatneg(lower_bound)) {`
		6099	`if (h <= 255) {`
		6100	`return ucharsh;`
		6101	`}`
		6102	`if (h <= 65535) {`
		6103	`return uwordsh;`
		6104	`}`
		6105	`return ulongsh;`
		6106	`}`
2	7u83	6107
6	7u83	6108	`if (l <= 128 && h <= 127) {`
		6109	`return scharsh;`
		6110	`}`
		6111	`if (l<= 32768 && h <= 32767) {`
		6112	`return swordsh;`
		6113	`}`
2	7u83	6114
6	7u83	6115	`return slongsh;`
2	7u83	6116	`}`
		6117
6	7u83	6118
		6119	`variety`
		6120	`f_var_width(bool sig, nat bits)`
2	7u83	6121	`{`
6	7u83	6122	`int w = natint(bits);`
		6123	`if (sig) {`
		6124	`if (w <= 8) {`
		6125	`return scharsh;`
		6126	`}`
		6127	`if (w <= 16) {`
		6128	`return swordsh;`
		6129	`}`
		6130	`if (w <= 32) {`
		6131	`return slongsh;`
		6132	`}`
		6133	`if (w <= 64) {`
		6134	`return s64sh;`
		6135	`}`
		6136	`failer(WIDTH_ERROR);`
		6137	`return slongsh;`
		6138	`}`
2	7u83	6139
6	7u83	6140	`if (w <= 8) {`
		6141	`return ucharsh;`
		6142	`}`
		6143	`if (w <= 16) {`
		6144	`return uwordsh;`
		6145	`}`
		6146	`if (w <= 32) {`
		6147	`return ulongsh;`
		6148	`}`
		6149	`if (w <= 64) {`
		6150	`return u64sh;`
		6151	`}`
		6152	`failer(WIDTH_ERROR);`
		6153	`return ulongsh;`
2	7u83	6154	`}`
		6155
6	7u83	6156
2	7u83	6157	`void init_variety`
6	7u83	6158	`(void)`
2	7u83	6159	`{`
6	7u83	6160	`ucharsh = getshape(0, const_al1, const_al1, UCHAR_ALIGN, UCHAR_SZ,`
		6161	`ucharhd);`
		6162	`scharsh = getshape(1, const_al1, const_al1, SCHAR_ALIGN, SCHAR_SZ,`
		6163	`scharhd);`
		6164	`uwordsh = getshape(0, const_al1, const_al1, UWORD_ALIGN, UWORD_SZ,`
		6165	`uwordhd);`
		6166	`swordsh = getshape(1, const_al1, const_al1, SWORD_ALIGN, SWORD_SZ,`
		6167	`swordhd);`
		6168	`ulongsh = getshape(0, const_al1, const_al1, ULONG_ALIGN, ULONG_SZ,`
		6169	`ulonghd);`
		6170	`slongsh = getshape(1, const_al1, const_al1, SLONG_ALIGN, SLONG_SZ,`
		6171	`slonghd);`
		6172	`u64sh = getshape(0, const_al1, const_al1, U64_ALIGN, U64_SZ, u64hd);`
		6173	`s64sh = getshape(1, const_al1, const_al1, S64_ALIGN, S64_SZ, s64hd);`
		6174	`return;`
2	7u83	6175	`}`
		6176
6	7u83	6177
2	7u83	6178	`variety f_dummy_variety;`
		6179
6	7u83	6180	`version`
		6181	`f_make_version(tdfint major_version, tdfint minor_version)`
2	7u83	6182	`{`
6	7u83	6183	`version res;`
		6184	`res.major_version = natint(major_version);`
		6185	`res.minor_version = natint(minor_version);`
		6186	`if (res.major_version >= 3) {`
		6187	`newcode = 1;`
		6188	`} else {`
		6189	`newcode = 0;`
		6190	`}`
		6191	`return res;`
2	7u83	6192	`}`
		6193
6	7u83	6194
		6195	`version_props`
		6196	`f_make_versions(version_props version_info)`
2	7u83	6197	`{`
6	7u83	6198	`UNUSED(version_info);`
		6199	`return 0;`
2	7u83	6200	`}`
		6201
		6202
6	7u83	6203	`exp_list`
		6204	`new_exp_list(int n)`
2	7u83	6205	`{`
6	7u83	6206	`exp_list res;`
		6207	`UNUSED(n);`
		6208	`res.number = 0;;`
		6209	`res.start = nilexp;`
		6210	`res.end = nilexp;`
2	7u83	6211
6	7u83	6212	`return res;`
2	7u83	6213	`}`
		6214
6	7u83	6215
		6216	`exp_list`
		6217	`add_exp_list(exp_list list, exp elem, int index)`
2	7u83	6218	`{`
6	7u83	6219	`UNUSED(index);`
		6220	`++list.number;`
		6221	`parked(elem) = 1;`
		6222	`if (list.start == nilexp) {`
		6223	`list.start = elem;`
		6224	`list.end = elem;`
		6225	`setlast(elem);`
		6226	`bro(elem) = nilexp;`
		6227	`return list;`
		6228	`}`
		6229	`clearlast(list.end);`
		6230	`bro(list.end) = elem;`
		6231	`list.end = elem;`
		6232	`setlast(elem);`
		6233	`bro(elem) = nilexp;`
		6234	`return list;`
2	7u83	6235	`}`
		6236
6	7u83	6237
		6238	`caselim_list`
		6239	`new_caselim_list(int n)`
2	7u83	6240	`{`
6	7u83	6241	`UNUSED(n);`
		6242	`/* bro(global_case) = nilexp;`
		6243	`return 0;`
		6244	`*/`
		6245	`return nilexp;`
2	7u83	6246	`}`
		6247
6	7u83	6248
		6249	`caselim_list`
		6250	`add_caselim_list(caselim_list list, caselim elem, int index)`
2	7u83	6251	`{`
6	7u83	6252	`/* see the documentation for the representation of cases */`
		6253	`exp ht;`
		6254	`int low;`
		6255	`int high;`
		6256	`exp lowval = getexp(slongsh, nilexp, 0, nilexp, nilexp, 0, 0, 0);`
		6257	`/* UNUSED(list); */`
		6258	`UNUSED(index);`
		6259	`pt(lowval) = get_lab(elem.lab); /* label for this branch */`
2	7u83	6260
6	7u83	6261	`if (snat_issmall(elem.low)) {`
		6262	`low = snatint(elem.low);`
		6263	`if (snatneg(elem.low)) {`
		6264	`low = - low;`
		6265	`}`
		6266	`} else {`
2	7u83	6267	`#if !has64bits`
6	7u83	6268	`SET(low);`
		6269	`failer(TOO_BIG_A_CASE_ELEMENT);`
2	7u83	6270	`#else`
6	7u83	6271	`low = snatbig(elem.low);`
		6272	`if (snatneg(elem.low)) {`
		6273	`flpt z = new_flpt();`
		6274	`flt_copy(flptnos[low], &flptnos[z]);`
		6275	`low = z;`
		6276	`flptnos[low].sign = - flptnos[low].sign;`
		6277	`}`
		6278	`setbigval(lowval);`
2	7u83	6279	`#endif`
6	7u83	6280	`}`
		6281	`no(lowval) = low;`
2	7u83	6282
6	7u83	6283	`if (snat_issmall(elem.high)) {`
		6284	`high = snatint(elem.high);`
		6285	`if (snatneg(elem.high)) {`
		6286	`high = - high;`
		6287	`}`
		6288	`if (!isbigval(lowval) && high == low) {`
		6289	`ht = nilexp;`
		6290	`} else {`
		6291	`ht = getexp(slongsh, nilexp, 1, nilexp, nilexp, 0,`
		6292	`high, 0);`
		6293	`}`
		6294	`} else {`
2	7u83	6295	`#if !has64bits`
6	7u83	6296	`SET(ht);`
		6297	`failer(TOO_BIG_A_CASE_ELEMENT);`
2	7u83	6298	`#else`
6	7u83	6299	`int lh_eq;`
		6300	`high = snatbig(elem.high);`
		6301	`if (snatneg(elem.high)) {`
		6302	`flpt z = new_flpt();`
		6303	`flt_copy(flptnos[high], &flptnos[z]);`
		6304	`high = z;`
		6305	`flptnos[high].sign = - flptnos[high].sign;`
		6306	`}`
		6307	`if (isbigval(lowval)) {`
		6308	`lh_eq = flt_cmp(flptnos[low], flptnos[high]);`
		6309	`} else {`
		6310	`lh_eq = 0;`
		6311	`}`
2	7u83	6312
6	7u83	6313	`if (!lh_eq) {`
		6314	`ht = getexp(slongsh, nilexp, 1, nilexp, nilexp, 0,`
		6315	`high, 0);`
		6316	`setbigval(ht);`
		6317	`} else {`
		6318	`ht = nilexp;`
		6319	`}`
2	7u83	6320	`#endif`
6	7u83	6321	`}`
2	7u83	6322
6	7u83	6323	`/* if (ht != nilexp && docmp_f((int)f_less_than, ht, lowval)){`
		6324	`retcell(lowval);`
		6325	`retcell(ht);`
		6326	`return 0;`
		6327	`}`
		6328	`*/`
		6329	`++no(son(pt(lowval))); /* record label use */`
		6330	`son(lowval) = ht;`
		6331	`/* case_item (lowval);`
		6332	`*/`
		6333	`bro(lowval) = list;`
		6334	`return lowval;`
2	7u83	6335	`}`
		6336
6	7u83	6337
		6338	`label_list`
		6339	`new_label_list(int n)`
2	7u83	6340	`{`
6	7u83	6341	`label_list res;`
		6342	`res.elems = (label *)xcalloc(n, sizeof(label));`
		6343	`res.number = n;`
		6344	`return res;`
2	7u83	6345	`}`
		6346
6	7u83	6347
		6348	`label_list`
		6349	`add_label_list(label_list list, label elem, int index)`
2	7u83	6350	`{`
6	7u83	6351	`exp def;`
		6352	`exp labst;`
		6353	`def = getexp(f_top, nilexp, 0, nilexp, nilexp, 0, 0, clear_tag);`
		6354	`labst = getexp(f_bottom, nilexp, 0, def, nilexp, 0, 0, labst_tag);`
		6355	`fno(labst) = default_freq;`
		6356	`++proc_label_count;`
		6357	`set_lab(elem, labst);`
		6358	`list.elems[index] = elem;`
		6359	`return list;`
2	7u83	6360	`}`
		6361
6	7u83	6362
		6363	`tagshacc_list`
		6364	`new_tagshacc_list(int n)`
2	7u83	6365	`{`
6	7u83	6366	`tagshacc_list res;`
		6367	`res.size = 0;`
		6368	`res.id = nilexp;`
		6369	`res.last_id = nilexp;`
		6370	`res.last_def = nilexp;`
		6371	`res.number = n;`
		6372	`return res;`
2	7u83	6373	`}`
		6374
6	7u83	6375
		6376	`tagshacc_list`
		6377	`add_tagshacc_list(tagshacc_list list, tagshacc elem, int index)`
2	7u83	6378	`{`
6	7u83	6379	`exp d = getexp(elem.sha, nilexp, 0, nilexp, nilexp, 0, 0, clear_tag);`
		6380	`exp i = getexp(f_bottom, list.last_id, 1, d, nilexp, 0, 0, ident_tag);`
		6381	`UNUSED(index);`
		6382	`set_tag(elem.tg, i);`
		6383	`if (list.id == nilexp) {`
		6384	`list.id = i;`
		6385	`} else {`
		6386	`bro(list.last_def) = i;`
		6387	`}`
		6388	`list.last_def = d;`
		6389	`list.last_id = i;`
		6390	`if (elem.visible & (f_visible \| f_long_jump_access)) {`
		6391	`setvis(i);`
		6392	`}`
		6393	`if (elem.visible & f_out_par) {`
		6394	`setoutpar(i);`
		6395	`}`
		6396	`setvar(i);`
		6397	`setparam(i);`
		6398	`return list;`
2	7u83	6399	`}`
		6400
6	7u83	6401
		6402	`version_list`
		6403	`new_version_list(int n)`
2	7u83	6404	`{`
6	7u83	6405	`UNUSED(n);`
		6406	`return 0;`
2	7u83	6407	`}`
		6408
6	7u83	6409
2	7u83	6410	`static int version_printed = 0;`
		6411
6	7u83	6412	`version_list`
		6413	`add_version_list(version_list list, version elem, int index)`
2	7u83	6414	`{`
6	7u83	6415	`UNUSED(list);`
		6416	`UNUSED(index);`
		6417	`if (global_version.major_version == 0) {`
		6418	`global_version = elem;`
		6419	`}`
2	7u83	6420
6	7u83	6421	`if (elem.major_version != global_version.major_version) {`
		6422	`failer(WRONG_VERSION);`
		6423	`IGNORE fprintf(stderr, "This TDF has mixed versions\n");`
		6424	`}`
2	7u83	6425
6	7u83	6426	`if (report_versions) {`
		6427	`if (!version_printed) {`
		6428	`version_printed = 1;`
		6429	`IGNORE fprintf(stderr, "This TDF is composed from Capsules of the following versions:-\n");`
		6430	`}`
		6431	`IGNORE fprintf(stderr, "TDF Version %d.%d\n",`
		6432	`elem.major_version, elem.minor_version);`
		6433	`}`
2	7u83	6434
6	7u83	6435	`return 0;`
2	7u83	6436	`}`
		6437
6	7u83	6438
2	7u83	6439	`version f_dummy_version;`
		6440
		6441	`access_option no_access_option = 0;`
		6442
6	7u83	6443	`access_option`
		6444	`yes_access_option(access acc)`
2	7u83	6445	`{`
6	7u83	6446	`return acc;`
2	7u83	6447	`}`
		6448
6	7u83	6449
2	7u83	6450	`string_option no_string_option;`
6	7u83	6451	`string_option`
		6452	`yes_string_option(string s)`
2	7u83	6453	`{`
6	7u83	6454	`string_option res;`
2	7u83	6455	`res.val = s;`
		6456	`res.present = 1;`
6	7u83	6457	`return res;`
2	7u83	6458	`}`
		6459
6	7u83	6460
		6461	`void`
		6462	`init_string_option(void)`
2	7u83	6463	`{`
		6464	`no_string_option.present = 0;`
		6465	`}`
		6466
		6467
		6468	`tagacc_option no_tagacc_option;`
6	7u83	6469	`tagacc_option`
		6470	`yes_tagacc_option(tagacc elem)`
2	7u83	6471	`{`
6	7u83	6472	`tagacc_option res;`
		6473	`res.val = elem;`
		6474	`res.present = 1;`
		6475	`return res;`
2	7u83	6476	`}`
		6477
6	7u83	6478
		6479	`void`
		6480	`init_tagacc_option(void)`
2	7u83	6481	`{`
6	7u83	6482	`no_tagacc_option.present = 0;`
		6483	`return;`
2	7u83	6484	`}`
		6485
6	7u83	6486
2	7u83	6487	`nat_option no_nat_option;`
6	7u83	6488	`nat_option`
		6489	`yes_nat_option(nat n)`
2	7u83	6490	`{`
6	7u83	6491	`nat_option res;`
		6492	`res.val = n;`
		6493	`res.present = 1;`
		6494	`return res;`
2	7u83	6495	`}`
		6496
6	7u83	6497
		6498	`void`
		6499	`init_nat_option(void)`
2	7u83	6500	`{`
6	7u83	6501	`no_nat_option.present = 0;`
		6502	`return;`
2	7u83	6503	`}`
		6504
6	7u83	6505
		6506	`void`
		6507	`init_tagacc(void)`
2	7u83	6508	`{`
6	7u83	6509	`return;`
2	7u83	6510	`}`
		6511
6	7u83	6512
		6513	`tagacc`
		6514	`f_make_tagacc(tag tg, access_option acc)`
2	7u83	6515	`{`
6	7u83	6516	`tagacc res;`
		6517	`res.tg = tg;`
		6518	`res.visible = acc;`
		6519	`return res;`
2	7u83	6520	`}`
		6521
6	7u83	6522
		6523	`void`
		6524	`init_transfer_mode(void)`
2	7u83	6525	`{`
6	7u83	6526	`return;`
2	7u83	6527	`}`
		6528
6	7u83	6529
		6530	`void`
		6531	`init_version_props(void)`
2	7u83	6532	`{`
6	7u83	6533	`global_version.major_version = 0;`
		6534	`global_version.minor_version = 0;`
		6535	`return;`
2	7u83	6536	`}`
		6537
6	7u83	6538
		6539	`void`
		6540	`init_version(void)`
2	7u83	6541	`{`
6	7u83	6542	`return;`
2	7u83	6543	`}`
		6544
		6545
6	7u83	6546	`void`
		6547	`init_access_option(void)`
2	7u83	6548	`{`
6	7u83	6549	`return;`
2	7u83	6550	`}`
		6551
		6552
		6553	`static int seq_n = 0;`
		6554
6	7u83	6555	`char *`
		6556	`init_NAME(char *good_name)`
2	7u83	6557	`{`
6	7u83	6558	`char *prefix = "__I.TDF";`
		6559	`time_t t;`
		6560	`int i, j;`
		6561	`char *c;`
		6562	`char *res;`
		6563	`int sc;`
		6564	`int sp;`
		6565	`int sg;`
		6566	`t = time(NULL) + (time_t)(seq_n++);`
		6567	`c = asctime(localtime(&t));`
		6568	`sc = (int)strlen(c);`
		6569	`sp = (int)strlen(prefix);`
		6570	`sg = (int)strlen(good_name);`
		6571	`res = (char*)xcalloc(sc + sp + sg, sizeof(char));`
		6572	`for (i = 0; i < sp; i++) {`
		6573	`res[i] = prefix[i];`
		6574	`}`
		6575	`for (j = 0; j < sg; i++, j++) {`
		6576	`res[i] = good_name[j];`
		6577	`}`
		6578	`for (j = 0; j < sc; j++) {`
		6579	`if (isalpha(c[j]) \|\| isdigit(c[j])) {`
		6580	`res[i] = c[j]; i++;`
		6581	`}`
		6582	`}`
		6583	`res[i] = 0;`
		6584	`dynamic_init_proc = res;`
		6585	`return (res);`
2	7u83	6586	`}`
		6587
6	7u83	6588
		6589	`void`
		6590	`start_initial_value(void)`
2	7u83	6591	`{`
6	7u83	6592	`if (in_initial_value++ == 0) {`
		6593	`proc_props real_pp = (proc_props )0;`
		6594	`if (old_proc_props != (proc_props *)0) {`
		6595	`/* initial value in proc */`
		6596	`push_proc_props();`
		6597	`real_pp = old_proc_props;`
		6598	`}`
		6599	`old_proc_props = &initial_value_pp;`
		6600	`pop_proc_props();`
		6601	`old_proc_props = real_pp;`
2	7u83	6602	`}`
		6603	`}`
		6604
6	7u83	6605
		6606	`exp`
		6607	`f_initial_value(exp e)`
2	7u83	6608	`{`
6	7u83	6609	`if (--in_initial_value > 0) {`
		6610	`return e;`
		6611	`}`
2	7u83	6612
6	7u83	6613	`initial_value_pp.proc_struct_result = proc_struct_result;`
		6614	`initial_value_pp.has_alloca = has_alloca;`
		6615	`initial_value_pp.proc_is_recursive = proc_is_recursive;`
		6616	`initial_value_pp.uses_crt_env = uses_crt_env;`
		6617	`initial_value_pp.has_setjmp = has_setjmp;`
		6618	`initial_value_pp.uses_loc_address = uses_loc_address;`
		6619	`initial_value_pp.proc_label_count = proc_label_count;`
		6620	`initial_value_pp.proc_struct_res = proc_struct_res;`
		6621	`initial_value_pp.default_freq = default_freq;`
		6622	`initial_value_pp.proc_externs = proc_externs;`
		6623	`initial_value_pp.in_proc_def = in_proc_def;`
		6624	`initial_value_pp.pushed = old_proc_props;`
		6625	`initial_value_pp.rep_make_proc = rep_make_proc;`
		6626	`if (old_proc_props != (proc_props *)0) {`
2	7u83	6627	`/* init was in a proc - must make new variable */`
6	7u83	6628	`dec *my_def = make_extra_dec(make_local_name(), 1, 0, me_u2(e,`
		6629	`initial_value_tag), sh(e));`
		6630	`exp crt_exp = my_def->dec_u.dec_val.dec_exp;`
2	7u83	6631	`pop_proc_props();`
		6632	`return f_contents(sh(e), me_obtain(crt_exp));`
		6633	`}`
		6634	`return me_u2(e, initial_value_tag);`
		6635	`}`
		6636
6	7u83	6637
		6638	`void`
		6639	`tidy_initial_values(void)`
2	7u83	6640	`{`
6	7u83	6641	`dec *my_def = top_def;`
		6642	`exp_list initial_as;`
		6643	`exp_list prom_as;`
		6644	`char good_name = (char )0;`
		6645	`initial_as = new_exp_list(0);`
		6646	`prom_as = new_exp_list(0);`
		6647	`dynamic_init_proc = (char *)0;`
		6648	`while (my_def != (dec *)0) {`
		6649	`exp crt_exp = my_def->dec_u.dec_val.dec_exp;`
		6650	`if (son(crt_exp) != nilexp && my_def->dec_u.dec_val.extnamed) {`
		6651	`good_name = my_def->dec_u.dec_val.dec_id;`
2	7u83	6652	`}`
6	7u83	6653	`if (son(crt_exp) != nilexp &&`
		6654	`name(son(crt_exp)) == initial_value_tag) {`
		6655	`/* accumulate assignments of initial values in one`
		6656	`explist */`
		6657	`if (!(my_def->dec_u.dec_val.dec_var)) {`
		6658	`/* make sure its a variable */`
		6659	`exp p = pt(crt_exp);`
		6660	`setvar(crt_exp);`
		6661	`my_def->dec_u.dec_val.dec_var = 1;`
		6662	`while (p != nilexp) {`
		6663	`exp np = pt(p);`
		6664	`exp c = hold_check(f_contents(sh(p),`
		6665	`me_obtain(crt_exp)));`
		6666	`replace(p, c, nilexp);`
		6667	`p = np;`
		6668	`}`
		6669	`}`
		6670	`{`
		6671	`exp init = son(son(crt_exp));`
		6672	`exp new_init = f_make_value(sh(init));`
		6673	`if (good_name == (char *)0) {`
		6674	`good_name =`
		6675	`my_def->dec_u.dec_val.dec_id;`
		6676	`}`
		6677	`retcell(son(crt_exp));`
		6678	`son(crt_exp) = new_init;`
		6679	`bro(new_init) = crt_exp; setlast(new_init);`
		6680	`initial_as = add_exp_list(initial_as,`
		6681	`hold_check(f_assign(me_obtain(crt_exp),`
		6682	`init)), 0);`
		6683	`}`
2	7u83	6684	`}`
6	7u83	6685	`if (do_prom && son(crt_exp) != nilexp &&`
		6686	`my_def->dec_u.dec_val.dec_var && !is_comm(son(crt_exp))) {`
		6687	`/* accumulate assignments of non-zero initialisations`
		6688	`in one explist */`
		6689	`exp init = son(crt_exp);`
		6690	`exp new_init = f_make_value(sh(init));`
		6691	`if (good_name == (char *)0) {`
		6692	`good_name = my_def->dec_u.dec_val.dec_id;`
		6693	`}`
		6694	`if (name(init) == compound_tag \|\|`
		6695	`name(init) == nof_tag \|\|`
		6696	`name(init) == concatnof_tag \|\|`
		6697	`name(init) == ncopies_tag \|\|`
		6698	`name(init) == string_tag) {`
		6699	`dec *id_dec = make_extra_dec(make_local_name(),`
		6700	`0, 0, init,`
		6701	`sh(init));`
		6702	`init = me_obtain(id_dec->dec_u.dec_val.dec_exp);`
		6703	`}`
		6704	`son(crt_exp) = new_init;`
		6705	`no(new_init) = -1; /* we may need to distinguish for`
		6706	`diags */`
		6707	`bro(new_init) = crt_exp;`
		6708	`setlast(new_init);`
		6709	`prom_as = add_exp_list(prom_as,`
		6710	`hold_check(f_assign(me_obtain(`
		6711	`crt_exp), init)), 0);`
2	7u83	6712	`}`
6	7u83	6713	`my_def = my_def->def_next;`
2	7u83	6714	`}`
6	7u83	6715	`if (initial_as.number != 0) {`
		6716	`/* ie there are some dynamic initialisations */`
		6717	`exp prc;`
		6718	`dec *extra_dec;`
		6719	`tagshacc_list tsl;`
2	7u83	6720
6	7u83	6721	`exp ret = f_return(f_make_top());`
		6722	`exp seq = f_sequence(initial_as, ret);`
		6723	`tsl = new_tagshacc_list(0);`
2	7u83	6724
6	7u83	6725	`old_proc_props = &initial_value_pp; pop_proc_props();`
		6726	`old_proc_props = (proc_props *)0;`
		6727	`rep_make_proc = 0;`
		6728	`push_proc_props();`
		6729	`prc = f_make_proc(f_top, tsl, no_tagacc_option, seq);`
2	7u83	6730	`/* prc has one visible param - hence looks like varargs */`
6	7u83	6731	`if (do_prom) {`
		6732	`/* struct (proc, ptr) */`
		6733	`exp off_proc = hold_check(f_offset_zero(PROC_ALIGN));`
		6734	`exp off_ptr = hold_check(f_offset_pad(PTR_ALIGN,`
		6735	`hold_check(f_offset_add(copy(`
		6736	`off_proc), hold_check(`
		6737	`f_shape_offset(f_proc))))));`
		6738	`shape str_sh = f_compound(hold_check(f_offset_add(copy(`
		6739	`off_ptr), hold_check(`
		6740	`f_shape_offset(f_pointer(`
		6741	`PROC_ALIGN))))));`
		6742	`dec *str_dec = make_extra_dec(make_local_name(), 1, 0,`
		6743	`f_make_value(str_sh),`
		6744	`str_sh);`
		6745	`dec *prc_dec = make_extra_dec(make_local_name(), 0, 0,`
		6746	`prc, f_proc);`
		6747	`exp prc_exp = prc_dec->dec_u.dec_val.dec_exp;`
		6748	`exp str_exp = str_dec->dec_u.dec_val.dec_exp;`
		6749	`exp list_exp = find_named_tg("__PROM_init_list",`
		6750	`f_pointer(f_alignment(`
		6751	`str_sh)));`
		6752	`brog(list_exp)->dec_u.dec_val.dec_var = 1;`
		6753	`setvar(list_exp);`
		6754	`prom_as = add_exp_list(prom_as, hold_check(f_assign(`
		6755	`f_add_to_ptr(me_obtain(str_exp),`
		6756	`copy(off_proc)),`
		6757	`me_obtain(prc_exp))), 0);`
		6758	`prom_as = add_exp_list(prom_as, hold_check(f_assign(`
		6759	`f_add_to_ptr(me_obtain(str_exp),`
		6760	`copy(off_ptr)),`
		6761	`f_contents(sh(list_exp),`
		6762	`me_obtain(list_exp)))), 0);`
		6763	`prom_as = add_exp_list(prom_as, hold_check(f_assign(`
		6764	`me_obtain(list_exp),`
		6765	`me_obtain(str_exp))), 0);`
		6766	`} else {`
		6767	`extra_dec = make_extra_dec(add_prefix(init_NAME(`
		6768	`good_name)), 0, 1, prc,`
		6769	`f_proc);`
		6770	`}`
2	7u83	6771	`}`
6	7u83	6772	`if (do_prom && prom_as.number != 0) {`
		6773	`/* ie there are some prom initialisations */`
		6774	`exp prc;`
		6775	`dec *extra_dec;`
		6776	`tagshacc_list tsl;`
2	7u83	6777
6	7u83	6778	`exp ret = f_return(f_make_top());`
		6779	`exp seq = f_sequence(prom_as, ret);`
		6780	`tsl = new_tagshacc_list(0);`
2	7u83	6781
6	7u83	6782	`rep_make_proc = 0;`
		6783	`start_make_proc(f_top, tsl, no_tagacc_option);`
		6784	`prc = f_make_proc(f_top, tsl, no_tagacc_option, seq);`
		6785	`extra_dec = make_extra_dec(add_prefix(init_NAME(good_name)), 0,`
		6786	`1, prc, f_proc);`
		6787	`}`
2	7u83	6788	`}`

Subversion Repositories tendra.SVN

(root)/branches/tendra5-amd64/src/installers/common/construct/install_fns.c – Rev 6