WebSVN – tendra.SVN – Blame – /trunk/src/installers/common/construct/foralls.c

Rev	Author	Line No.	Line
2	7u83	1	`/*`
7	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: release $
		63	$Date: 1998/01/17 15:55:47 $
		64	$Revision: 1.1.1.1 $
		65	$Log: foralls.c,v $
		66	`* Revision 1.1.1.1 1998/01/17 15:55:47 release`
		67	`* First version to be checked into rolling release.`
		68	`*`
		69	`* Revision 1.4 1997/02/18 12:56:25 currie`
		70	`* NEW DIAG STRUCTURE`
		71	`*`
		72	`* Revision 1.3 1996/12/19 14:28:35 currie`
		73	`* Foralls - using two counters`
		74	`*`
		75	`Revision 1.2 1995/06/26 13:04:35 currie`
		76	`make_stack_limit, env_size etc`
		77
		78	`* Revision 1.1 1995/04/06 10:44:05 currie`
		79	`* Initial revision`
		80	`*`
		81	`***********************************************************************/`
		82
		83
		84
		85	`#include "config.h"`
		86	`#include "common_types.h"`
		87	`#include "tags.h"`
		88	`#include "expmacs.h"`
		89	`#include "exp.h"`
		90	`#include "check.h"`
		91	`#include "shapemacs.h"`
		92	`#include "check_id.h"`
		93	`#include "install_fns.h"`
		94	`#include "const.h"`
		95	`#include "constmacs.h"`
		96	`#include "flags.h"`
		97	`#include "me_fns.h"`
		98	`#include "basicread.h"`
		99	`#include "xalloc.h"`
		100	`#include "externs.h"`
		101	`#include "foralls.h"`
		102
		103	`#define subvar 0x100`
		104
		105	`#define false 0`
		106	`#define true 1`
		107
		108	`#define topsh f_top`
		109
		110	`#ifndef Assert`
		111	`#if FS_STDC_HASH`
7	7u83	112	`#define Assert(x) if (!(x)) failer(#x)`
2	7u83	113	`#else`
7	7u83	114	`#define Assert(x) if (!(x)) failer("x")`
2	7u83	115	`#endif`
		116	`#endif`
		117
7	7u83	118	`exp *`
		119	`ifc_ptr_position(exp e)`
2	7u83	120	`{`
7	7u83	121	`exp *a;`
2	7u83	122	`exp dad = father(e);`
7	7u83	123	`if (son(dad) == e) {`
2	7u83	124	`a = &son(dad);`
7	7u83	125	`} else {`
2	7u83	126	`exp sib = son(dad);`
7	7u83	127	`while (bro(sib) != e) {`
		128	`sib = bro(sib);`
		129	`}`
2	7u83	130	`a = &bro(sib);`
		131	`}`
		132	`return a;`
		133	`}`
		134
7	7u83	135
		136	`static exp *`
		137	`position(exp e)`
2	7u83	138	`{`
		139	`exp dad = father(e);`
		140	`exp *res = &son(dad);`
7	7u83	141	`while (*res != e) {`
		142	`res = &bro(*res);`
		143	`}`
2	7u83	144	`return res;`
		145	`}`
		146
7	7u83	147
		148	`int`
		149	`incr_var(exp e)`
2	7u83	150	`{`
		151	`/* is e var = var + val; */`
		152	`exp dest;`
		153	`exp src;`
7	7u83	154	`if (name(e) != ass_tag) {`
		155	`return false;`
		156	`}`
2	7u83	157	`dest = son(e);`
		158	`src = bro(dest);`
7	7u83	159	`return (name(dest) == name_tag && name(src) == plus_tag &&`
		160	`name(son(src)) == name_tag && name(bro(son(src))) == val_tag &&`
		161	`last(bro(son(src))) && son(dest) == son(son(src)) &&`
		162	`no(dest) == no(son(src)));`
2	7u83	163	`}`
		164
7	7u83	165
2	7u83	166	`exp alteredset = nilexp;`
		167
7	7u83	168	`void`
		169	`isaltered(exp ld, int always)`
2	7u83	170	`{`
		171	`/* make copy of name!! - can be killed later */`
7	7u83	172	`exp z;`
2	7u83	173	`exp nld;`
7	7u83	174	`for (z = alteredset; z != nilexp; z=bro(z)) {`
		175	`if (son(ld) == son(son(z)) &&`
		176	`(name(son(ld)) != proc_tag \|\| no(ld) == no(son(z)))) {`
2	7u83	177	`props(z) &= (prop)always;`
		178	`return;`
		179	`}`
		180	`}`
7	7u83	181	`nld = getexp(sh(ld), alteredset, 1, son(ld), nilexp, props(ld), no(ld),`
		182	`name(ld));`
		183	`alteredset = getexp(nilexp, alteredset, alteredset == nilexp, nld,`
		184	`nilexp, (prop)always, 0, 0);`
2	7u83	185	`}`
		186
7	7u83	187
2	7u83	188	`int assign_alias;`
		189	`int jump_out;`
		190
7	7u83	191	`void`
		192	`scan_for_incr(exp e, exp piece, void(*f)(exp, int))`
2	7u83	193	`{`
7	7u83	194	`/* applies f to all (var = var + val) done in piece with bool set if`
		195	`* always done. where var is non-local of piece but non-global and not`
		196	`* aliased and all other uses in piece are cont(var) also applies`
		197	`* altered to named variables (name_tag) which are assigned to, either`
		198	`* in toto or by indexing. if there are any other assign_alias is set`
		199	`* true */`
2	7u83	200	`static int everytime = true;`
7	7u83	201	`switch (name(e)) {`
		202	`case name_tag:`
		203	`case env_offset_tag`
		204	`: return;`
		205	`case ass_tag: {`
2	7u83	206	`exp dest = son(e);`
		207	`exp src = bro(son(e));`
7	7u83	208	`if (name(dest) == name_tag && isvar(son(dest)) &&`
		209	`!isglob(son(dest)) && iscaonly(son(dest)) &&`
		210	`name(src) == plus_tag) {`
		211	`exp la = son(src);`
2	7u83	212	`exp ra = bro(son(src));`
7	7u83	213	`if (last(ra) && name(ra) == val_tag && name(la) == cont_tag &&`
		214	`name(son(la)) == name_tag && son(son(la)) == son(dest) &&`
		215	`no(dest) == no(son(la)) && !intnl_to(piece, son(dest))) {`
		216	`exp p = pt(son(dest)); /uses of var /`
		217	`for (; p != nilexp; p = pt(p)) {`
2	7u83	218	`#ifdef NEWDIAGS`
7	7u83	219	`if (isdiaginfo(p) \|\| p == dest \|\| p == son(la) \|\|`
2	7u83	220	`#else`
7	7u83	221	`if (p == dest \|\| p == son(la) \|\|`
2	7u83	222	`#endif`
7	7u83	223	`(last(p) && name(bro(p)) == cont_tag) \|\|`
		224	`incr_var(father(p)) \|\| !intnl_to(piece, p)) {`
		225	`continue;`
		226	`}`
		227	`goto tryalias;`
		228	`}`
		229	`f(e, everytime);`
		230	`return;`
		231	`}`
		232	`}`
		233	`tryalias:`
		234	`if (name(dest) == name_tag && isvar(son(dest))) {`
2	7u83	235	`isaltered(dest, everytime);`
7	7u83	236	`} else if (name(dest) == addptr_tag && name(son(dest)) == name_tag &&`
		237	`isvar(son(son(dest)))) {`
		238	`isaltered(son(dest), everytime);`
		239	`} else if (name(dest) == reff_tag && name(son(dest)) == addptr_tag &&`
		240	`name(son(son(dest))) == name_tag && isvar(son(son(son(dest))))) {`
		241	`isaltered(son(son(dest)), everytime);`
		242	`} else if (name(dest) == name_tag &&`
		243	`(props(son(dest)) & 0x10) != 0) {`
		244	`/* const in some loop */`
		245	`exp def = son(son(dest));`
		246	`if (name(def) == reff_tag) {`
		247	`def = son(def);`
		248	`}`
		249	`if (name(def) == addptr_tag && name(son(def)) == name_tag &&`
		250	`isvar(son(son(def)))) {`
2	7u83	251	`isaltered(dest, everytime);`
7	7u83	252	`} else {`
		253	`assign_alias = true;`
2	7u83	254	`}`
7	7u83	255	`} else {`
		256	`assign_alias = true;`
2	7u83	257	`}`
		258	`scan_for_incr(dest, piece, f);`
		259	`scan_for_incr(src, piece, f);`
7	7u83	260	`return;`
2	7u83	261	`}`
		262
7	7u83	263	`case case_tag:`
2	7u83	264	`scan_for_incr(son(e), piece, f);`
		265	`everytime = false;`
		266	`return;`
		267
		268	`case goto_tag: case testbit_tag:`
		269	`case test_tag: {`
		270	`int x = intnl_to(piece, pt(e));`
7	7u83	271	`if (!x) {`
		272	`jump_out = true;`
		273	`}`
		274	`if (son(e) != nilexp) {`
		275	`scan_for_incr(son(e), piece, f);`
		276	`}`
2	7u83	277	`everytime = (everytime && !x);`
		278	`return;`
		279	`}`
		280	`case res_tag: {`
		281	`jump_out = true;`
		282	`scan_for_incr(son(e), piece, f);`
		283	`return;`
		284	`}`
		285	`case solve_tag: case rep_tag: case cond_tag: {`
		286	`exp z = son(e);`
		287	`int et = everytime;`
7	7u83	288	`for (;;) {`
2	7u83	289	`scan_for_incr(z, piece, f);`
		290	`everytime = false;`
7	7u83	291	`if (last(z)) {`
		292	`break;`
		293	`}`
		294	`z = bro(z);`
2	7u83	295	`}`
		296	`everytime = et;`
		297	`return;`
		298	`}`
		299
		300	`case apply_tag: assign_alias = true; /* and do default */`
		301	`default: {`
		302	`exp z = son(e);`
7	7u83	303	`if (z == nilexp) {`
		304	`return;`
		305	`}`
		306	`for (;;) {`
2	7u83	307	`scan_for_incr(z, piece, f);`
7	7u83	308	`if (last(z)) {`
		309	`return;`
		310	`}`
2	7u83	311	`z = bro(z);`
		312	`}`
		313	`}`
		314	`}`
		315	`}`
		316
		317
7	7u83	318	`int`
		319	`good_val(exp a, exp piece)`
2	7u83	320	`{`
		321	`/* result ((a is name external to piece)`
		322	`\|\| (a is cont(name) where all uses of name in piece is cont))`
		323	`*/`
7	7u83	324	`if (name(a) == name_tag) {`
2	7u83	325	`return (!intnl_to(piece, son(a)));`
7	7u83	326	`} else if (name(a) == cont_tag && name(son(a)) == name_tag &&`
2	7u83	327	`!intnl_to(piece, son(son(a))) && !isvis(son(son(a)))) {`
		328	`exp lda = son(a);`
		329	`exp pa = pt(son(lda));`
7	7u83	330	`for (; pa != nilexp; pa = pt(pa)) {`
2	7u83	331	`#ifdef NEWDIAGS`
7	7u83	332	`if (isdiaginfo(pa) \|\| pa == lda \|\| no(pa) != no(lda) \|\|`
2	7u83	333	`#else`
7	7u83	334	`if (pa == lda \|\| no(pa) != no(lda) \|\|`
2	7u83	335	`#endif`
7	7u83	336	`(last(pa) && name(bro(pa)) == cont_tag) \|\|`
		337	`!intnl_to(piece, pa))continue;`
2	7u83	338	`break;`
		339	`}`
7	7u83	340	`return (pa == nilexp);`
2	7u83	341	`}`
		342	`return false;`
		343	`}`
		344
7	7u83	345
		346	`int`
		347	`usage_in(exp whole, exp part)`
2	7u83	348	`{`
		349	`exp q = part;`
		350	`int res = 1;`
		351	`int n = (int)name(q);`
		352	`while (q != whole && q != nilexp &&`
7	7u83	353	`(n != ident_tag \|\| (props(q) & 0x40) == 0)) {`
		354	`q = father(q);`
2	7u83	355	`n = (int)name(q);`
7	7u83	356	`if (n == cond_tag \|\| n == rep_tag \|\| n == solve_tag) {`
		357	`res=2;`
		358	`}`
2	7u83	359	`}`
		360
		361
		362	`return (q == whole)?res:0;`
		363	`}`
		364
		365	`int stride;`
7	7u83	366	`/* 0 initially, -1 either no common stride or non-constant stride, otherwise`
		367	`* contains common stride. */`
2	7u83	368
7	7u83	369	`int`
		370	`find_common_index(exp ldname, exp piece, void(*f)(exp, int))`
2	7u83	371	`{`
		372
7	7u83	373	`/* applies f to all addptr(x, cont(varid)) in piece where`
		374	`* good_index_factor(1) and all addptr(x, mult(cont(varid), mval))`
		375	`* where good_index_factor(mval) and and all test(cont(varid), val ->`
		376	`* outside piece) with bool if it is done exactly once. if different`
		377	`* multiply facters are detected or a multiplying factor is not good`
		378	`* then stride is set to -1 and the procedure returned from. stride`
		379	`* holds the common multiplying factor, initially being 0. where x is`
		380	`* name external to piece or x is cont(name) where name is external to`
		381	`* piece and all uses in piece are cont(name) NB no alias check result`
		382	`* is no of other uses of varid in piece */`
2	7u83	383	`exp p = pt(son(ldname));`
		384	`int otheruses = 0;`
7	7u83	385	`/* examine each use of loop variable */`
		386	`for(; p != nilexp; p = pt(p)) {`
2	7u83	387	`int usagex;`
		388	`#ifdef NEWDIAGS`
7	7u83	389	`if (isdiaginfo(p)) {`
		390	`continue;`
		391	`}`
2	7u83	392	`#endif`
7	7u83	393	`if (no(p) != no(ldname)) {`
		394	`continue;`
		395	`}`
2	7u83	396	`usagex = usage_in(piece, p);`
7	7u83	397	`if (usagex == 0) {`
		398	`continue;`
		399	`}`
2	7u83	400	`otheruses++;`
7	7u83	401	`if (last(p) && name(bro(p)) == cont_tag) {`
2	7u83	402	`exp dad = father(bro(p));`
7	7u83	403	`if (!good_index_factor(1)) {`
		404	`stride = -1;`
		405	`UNUSED(dad);`
		406	`UNUSED(f);`
		407	`return 0;`
		408	`}`
		409	`if (name(dad) == addptr_tag && bro(son(dad)) == bro(p) &&`
		410	`last(bro(p))) {`
		411	`if (good_val(son(dad), piece)) {`
		412	`f(dad, usagex == 1);`
2	7u83	413	`otheruses--;`
7	7u83	414	`if (stride == 0) {`
		415	`stride = 1;`
		416	`} else if (stride > 1) {`
		417	`stride = -1;`
		418	`UNUSED(f);`
		419	`return 0;`
		420	`}`
		421	`}`
		422	`} else if (name(dad) == offset_mult_tag && son(dad) == bro(p) &&`
		423	`name(bro(son(dad))) == val_tag && last(dad)) {`
		424	`exp grandad = father(dad);`
		425	`if (!good_index_factor(no(bro(son(dad))) / 8)) {`
		426	`stride = -1;`
		427	`UNUSED(grandad);`
		428	`return 0;`
		429	`}`
		430	`if (name(grandad) == addptr_tag && bro(son(grandad)) == dad &&`
		431	`last(dad)) {`
		432	`if (good_val(son(grandad), piece)) {`
		433	`f(grandad, usagex == 1);`
		434	`otheruses--;`
		435	`if (stride == 0) {`
		436	`stride = no(bro(son(dad))) / 8;`
		437	`} else if (stride != no(bro(son(dad))) / 8) {`
		438	`stride = -1;`
		439	`return 0;`
		440	`}`
		441	`/printf("stride=%d\n", stride);/`
		442	`}`
		443	`}`
		444	`} else if ((name(dad) == test_tag \|\| name(dad) == testbit_tag) &&`
		445	`piece == bro(son(pt(dad)))) {`
		446	`f(dad, usagex == 1);`
		447	`otheruses--;`
2	7u83	448	`}`
		449	`}`
		450	`}`
		451	`return otheruses;`
		452	`}`
		453
7	7u83	454
		455	`int`
		456	`find_pointer_opt(exp ldname, exp piece, void(*f)(exp, int))`
2	7u83	457	`{`
		458
7	7u83	459	`/* applies f to all addptr(x, cont(varid)) in piece where`
		460	`* good_pointer_factor(1) and all addptr(x, mult(cont(varid), mval))`
		461	`* where good_pointer_factor(mval) and and all test(cont(varid), val ->`
		462	`* outside piece) with bool if it is done exactly once. where x is`
		463	`* name external to piece or x is cont(name) where name is external to`
		464	`* piece and all uses in piece are cont(name) NB no alias check result`
		465	`* is no of other uses of varid in piece */`
2	7u83	466	`exp p = pt(son(ldname));`
		467	`int otheruses = 0;`
7	7u83	468	`for(; p != nilexp; p = pt(p)) {`
		469	`/* examine each use of loop variable */`
2	7u83	470	`int usagex;`
		471	`#ifdef NEWDIAGS`
7	7u83	472	`if (isdiaginfo(p)) {`
		473	`continue;`
		474	`}`
2	7u83	475	`#endif`
7	7u83	476	`if (no(p) != no(ldname)) {`
		477	`continue;`
		478	`}`
2	7u83	479	`usagex = usage_in(piece, p);`
7	7u83	480	`if (usagex == 0) {`
		481	`continue;`
		482	`}`
2	7u83	483	`otheruses++;`
7	7u83	484	`if (last(p) && name(bro(p)) == cont_tag) {`
2	7u83	485	`exp dad = father(bro(p));`
7	7u83	486	`if (name(dad) == addptr_tag && bro(son(dad)) == bro(p) &&`
		487	`last(bro(p)) && good_pointer_factor(1)) {`
		488	`if (good_val(son(dad), piece)) {`
		489	`f(dad, usagex == 1);`
2	7u83	490	`otheruses--;`
7	7u83	491	`if (stride == 0) {`
		492	`stride=1;`
		493	`} else if (stride > 1) {`
		494	`stride = -1;`
		495	`}`
		496	`}`
		497	`} else if (name(dad) == offset_mult_tag && son(dad) == bro(p) &&`
		498	`simple_const(piece, bro(son(dad)), false,`
		499	`!assign_alias) && last(dad) &&`
		500	`(name(bro(son(dad))) != val_tag \|\|`
		501	`good_pointer_factor(no(bro(son(dad))) / 8))) {`
		502	`exp grandad = father(dad);`
		503	`if (name(grandad) == addptr_tag && bro(son(grandad)) == dad &&`
		504	`last(dad)) {`
		505	`if (good_val(son(grandad), piece)) {`
		506	`int n = -1;`
		507	`f(grandad, usagex == 1);`
2	7u83	508	`otheruses--;`
7	7u83	509	`if (name(bro(son(dad))) == val_tag) {`
		510	`n = no(bro(son(dad))) /8;`
		511	`} else if (name(bro(son(dad))) == name_tag) {`
2	7u83	512	`exp id = son(bro(son(dad)));`
7	7u83	513	`if (name(son(id)) == val_tag) {`
2	7u83	514	`n = no(son(id));`
		515	`}`
		516	`}`
		517
7	7u83	518	`if (stride == 0) {`
		519	`stride = n;`
		520	`} else if (stride != n) {`
		521	`stride = -1;`
		522	`}`
		523	`}`
		524	`}`
		525	`} else if (name(dad) == test_tag && piece == bro(son(pt(dad)))) {`
		526	`f(dad, usagex == 1);`
		527	`otheruses--;`
		528	`}`
2	7u83	529	`}`
		530	`}`
7	7u83	531	`return otheruses;`
2	7u83	532	`}`
		533
7	7u83	534
2	7u83	535	`exp addptrs;`
		536	`/* nilexp initially */`
7	7u83	537	`/* son = addptr exp;`
		538	`pt = [holder with son = different occurence of addptr exp]**(no-1)`
		539	`chained through ptr`
		540	`props =1 if done exactly once`
		541	`other addptrs chained similarly through bro`
		542	`*/`
2	7u83	543
		544	`exp tests;`
		545	`/* nilexp initially */`
7	7u83	546	`/* son = test`
		547	`pt = [holder with son = different occurence of test]**(no-1)`
		548	`props = 1 if done exactly once`
		549	`other tests chained similarly through bro`
		550	`*/`
2	7u83	551
7	7u83	552	`void`
		553	`collect_loopthings(exp ind, int everytime)`
2	7u83	554	`{`
		555	`/* builds addptrs and tests*/`
		556	`exp z;`
7	7u83	557	`exp *loopthing = (name(ind) == test_tag) ? &tests : &addptrs;`
		558	`for (z = *loopthing; z != nilexp; z = bro(z)) {`
2	7u83	559	`if (eq_exp(son(z), ind)) {`
7	7u83	560	`exp n = getexp(topsh, nilexp, 0, ind, pt(z), 0, 0, 0);`
2	7u83	561	`pt(z) =n;`
7	7u83	562	`no(z) ++;`
2	7u83	563	`props(z) &= (prop)everytime;`
		564	`return;`
		565	`}`
		566	`}`
7	7u83	567	`loopthing = getexp(topsh, loopthing, *loopthing == nilexp, ind,`
		568	`nilexp, (prop)everytime, 1, 0);`
2	7u83	569	`}`
		570
		571
		572	`exp incrs;`
		573	`/* nilexp initially */`
7	7u83	574	`/* son = (v=v+val) exp;`
		575	`pt = [holder with son = different occurence with same v]**(no-1)`
		576	`chained through pt`
		577	`props = 1 if done exactly once`
		578	`other (v=v+val)s chained similarly through bro`
		579	`*/`
2	7u83	580
7	7u83	581	`int`
		582	`maybe_incr(exp e)`
2	7u83	583	`{`
		584	`exp incs = incrs;`
		585	`if (name(e) == cont_tag) {`
		586	`e = son(e);`
		587	`}`
7	7u83	588	`if (name(e) != name_tag) {`
		589	`return 1;`
		590	`}`
2	7u83	591	`while (incs != nilexp) {`
		592	`exp dest = son(son(incs));`
		593	`Assert(name(dest) == name_tag);`
7	7u83	594	`if (son(dest) == son(e)) {`
		595	`return 1;`
		596	`}`
2	7u83	597	`incs = bro(incs);`
		598	`}`
		599	`return 0;`
		600	`}`
		601
7	7u83	602
		603	`void`
		604	`collect_incrs(exp incr, int everytime)`
2	7u83	605	`{`
		606	`/* builds incrs */`
		607	`exp z;`
7	7u83	608	`for (z = incrs; z != nilexp; z = bro(z)) {`
2	7u83	609	`if (son(son(son(z))) == son(son(incr))`
7	7u83	610	`&& no(son(son(z))) == no(son(incr))) {`
		611	`exp n = getexp(topsh, nilexp, 0, incr, pt(z), 0, 0, 0);`
		612	`pt(z) = n;`
		613	`no(z) ++;`
2	7u83	614	`props(z) &= (prop)everytime;`
		615	`return;`
		616	`}`
		617	`}`
		618
7	7u83	619	`incrs = getexp(topsh, incrs, incrs == nilexp, incr, nilexp,`
		620	`(prop)everytime, 1, 0);`
2	7u83	621
		622	`}`
		623
		624
		625	`/* transforms:`
		626
		627	`strength reduction`
		628	`addptr(x, y) if x is invariant of loop`
		629	`ie x = simple var`
		630	`or x = cont(z) and z not altered in loop`
		631	`NB difference between invariant and not altered`
		632
		633
		634	`*/`
		635
		636
		637	`/* incr is only incrementer`
		638	`addptrset is holder of addptr`
		639	`loop is rep l:body`
		640	`exp * looppos = position(loop)`
		641
		642
		643	`always construct`
7	7u83	644	`Var X = add_ptr(x, y)`
2	7u83	645	`replace all add_ptrs by cont(X) in addptrset and loopbpdy`
		646	`replace incr by {X = reff(inc)c(X); incr}`
		647	`retaining handle on incr`
		648	`shift looppos to body`
		649
		650	`if always done and x not altered`
		651	`look for cont( ..reff(s) reff(s+inc) ...reff(s+n*inc) )`
		652	`replace loop by:`
		653	`Var Ci[0..n-1] = cont(ref(s+i*inc)cont(X))`
		654	`in loop with newbody:`
		655	`var Cn = cont(ref(s+n*inc)cont(X)) in`
		656	`body(reffn/Cn, incr/{ Ci=C[i+1]; incr})`
		657
		658	`*/`
		659
7	7u83	660	`static void`
		661	`extract_addptrs(exp incr, exp addptrset, exp loop, exp inc, int inci, int cons)`
2	7u83	662	`{`
		663	`/* replace loop by :`
7	7u83	664	`Var X = add_ptr(x, y) in newbody :`
2	7u83	665	`replace all add_ptrs by cont(X) in addptrset and loopbpdy`
		666	`replace incr by {X = reff(inc)c(X); incr}`
		667	`retaining handle on incr`
		668	`inc is in bytes.`
		669
		670	`*/`
		671	`shape shvar = f_pointer(long_to_al(shape_align(sh(son(addptrset)))));`
		672	`exp id = getexp(sh(loop), bro(loop), last(loop), son(addptrset),`
		673	`nilexp, 1 /var/, 0, ident_tag);`
		674	`/* setsib(son(id), loop); setdad(loop, id) later */`
		675	`int i;`
		676	`exp z = addptrset;`
7	7u83	677	`exp *pos;`
2	7u83	678	`exp ld, ass, reff, cont, seq, dest;`
		679	`exp incr_2, prod_2, neg_prod_2, mult_2;`
		680	`setcaonly(id);`
7	7u83	681	`for (i = 0; i < no(addptrset); i++) {`
2	7u83	682	`/* replace addptrs by cont(ld(id)) */`
		683	`exp sz = son(z) /the addptr /;`
7	7u83	684	`cont = getexp(sh(son(id)), bro(sz), last(sz), nilexp, nilexp, 0,`
		685	`0, cont_tag);`
2	7u83	686	`ld = getexp(shvar, cont, 1, id, pt(id), 0, 0, name_tag);`
		687	`pos = position(sz);`
		688	`son(cont) = ld;`
7	7u83	689	`pt(id) = ld;`
		690	`no(id) ++;`
2	7u83	691	`*pos = cont;`
		692	`son(z) = cont;`
7	7u83	693	`if (i != 0) {`
		694	`kill_exp(sz, nilexp);`
		695	`}`
2	7u83	696	`z = pt(z);`
		697	`}`
		698
7	7u83	699	`bro(son(id)) = loop;`
		700	`clearlast(son(id));`
2	7u83	701	`pos = position(loop);`
7	7u83	702	`bro(loop) = id;`
		703	`setlast(loop);`
2	7u83	704	`*pos = id;`
7	7u83	705	`if (cons \|\| no(inc) != 0) {`
		706	`int mult = no(inc)*inci;`
		707	`if (cons) {`
		708	`mult = inci * 8;`
		709	`}`
		710	`ld = getexp(shvar, nilexp, 1, id, pt(id), 0, 0, name_tag);`
		711	`pt(id) = ld;`
		712	`no(id) ++;`
		713	`cont = getexp(sh(son(id)), nilexp, 1, ld, nilexp, 0, 0,`
		714	`cont_tag);`
		715	`bro(ld) = cont;`
		716	`reff = getexp(sh(cont), nilexp, 1, cont, nilexp, 0, mult,`
		717	`reff_tag);`
		718	`bro(cont) = reff;`
		719	`dest = getexp(shvar, reff, 0, id, pt(id), 0, 0, name_tag);`
		720	`pt(id) = dest;`
		721	`no(id) ++;`
		722	`ass = getexp(topsh, nilexp, 1, dest, nilexp, 0, 0, ass_tag);`
		723	`bro(reff) = ass;`
		724	`z = getexp(topsh, incr, 0, ass, nilexp, 0, 0, 0);`
		725	`bro(ass) = z;`
		726	`seq = getexp(topsh, bro(incr), last(incr), z, nilexp, 0, 0,`
		727	`seq_tag);`
		728	`pos = position(incr);`
		729	`bro(incr) = seq;`
		730	`setlast(incr);`
		731	`*pos = seq;`
		732	`} else{`
		733	`mult_2 = copy(inc);`
		734	`if (inci < 0) {`
		735	`incr_2 = getexp(sh(inc), nilexp, 1, nilexp, nilexp, 0,`
		736	`-inci, val_tag);`
		737	`bro(incr_2) = mult_2;`
		738	`clearlast(incr_2);`
		739	`neg_prod_2 = getexp(sh(inc), nilexp, 1, incr_2, nilexp,`
		740	`0, 0, offset_mult_tag);`
		741	`neg_prod_2 = hc(neg_prod_2, mult_2);`
		742	`prod_2 = getexp(sh(inc), nilexp, 1, neg_prod_2, nilexp,`
		743	`0, 0, neg_tag);`
		744	`bro(neg_prod_2) = prod_2;`
		745	`} else {`
		746	`incr_2 = getexp(sh(inc), nilexp, 1, nilexp, nilexp, 0,`
		747	`inci, val_tag);`
		748	`bro(incr_2) = mult_2;`
		749	`clearlast(incr_2);`
		750	`prod_2 = getexp(sh(inc), nilexp, 0, incr_2, nilexp, 0,`
		751	`0, offset_mult_tag);`
		752	`prod_2 = hc(prod_2, mult_2);`
		753	`}`
		754	`ld = getexp(shvar, nilexp, 1, id, pt(id), 0, 0, name_tag);`
		755	`pt(id) = ld;`
		756	`no(id)++;`
		757	`cont = getexp(sh(son(id)), nilexp, 0, ld, nilexp, 0, 0,`
		758	`cont_tag);`
		759	`bro(ld) = cont;`
		760	`reff = getexp(sh(son(id)), nilexp, 1, cont, nilexp, 0, 0,`
		761	`addptr_tag);`
		762	`bro(cont) = prod_2;`
		763	`reff = hc(reff, prod_2);`
		764	`dest = getexp(shvar, reff, 0, id, pt(id), 0, 0, name_tag);`
		765	`pt(id) = dest;`
		766	`no(id)++;`
		767	`ass = getexp(topsh, nilexp, 1, dest, nilexp, 0, 0, ass_tag);`
		768	`bro(reff) = ass;`
		769	`z = getexp(topsh, incr, 0, ass, nilexp, 0, 0, 0);`
		770	`bro(ass) = z;`
		771	`seq = getexp(topsh, bro(incr), last(incr), z, nilexp, 0, 0,`
		772	`seq_tag);`
		773	`pos = position(incr);`
		774	`bro(incr) = seq;`
		775	`setlast(incr);`
		776	`*pos = seq;`
		777	`}`
2	7u83	778	`}`
		779
7	7u83	780
		781	`static void`
		782	`scale_loopid(exp loop, exp addptrset, exp incrset)`
2	7u83	783	`{`
		784	`/* replace loop body by :`
		785	`Var X = loopid*stride in newbody :`
		786	`replace all offset_mults by cont(X) in addptrset and loopbody`
		787	`replace incr by {X = c(X)+stride; incr}`
		788	`retaining handle on incr`
		789	`inc is in bytes.`
		790
		791	`*/`
7	7u83	792	`exp id = getexp(sh(loop), bro(loop), last(loop),`
		793	`bro(son(son(addptrset))), nilexp, 1 /var/, 0,`
		794	`ident_tag);`
2	7u83	795	`/* setsib(son(id), loop); setdad(loop, id) later */`
		796
7	7u83	797	`exp *pos;`
2	7u83	798	`exp incr = son(incrset);`
		799	`shape shvar = sh(son(bro(son(incr))));`
		800	`exp ld, ass, plus, cont, seq, dest, inc, z, next;`
7	7u83	801	`while (addptrset != nilexp) {`
		802	`int i;`
		803	`z = addptrset;`
		804	`next = bro(addptrset);`
		805	`setcaonly(id);`
		806	`for (i = 0; i < no(addptrset); i++) {`
		807	`/* replace addptrs by cont(ld(id)) */`
		808	`exp sz = bro(son(son(z))) /* the offset_mult */;`
		809	`cont = getexp(sh(son(id)), bro(sz), last(sz), nilexp,`
		810	`nilexp, 0, 0, cont_tag);`
		811	`ld = getexp(shvar, cont, 1, id, pt(id), 0, 0, name_tag);`
		812	`pos = position(sz);`
		813	`son(cont) = ld;`
		814	`pt(id) = ld;`
		815	`no(id) ++;`
		816	`*pos = cont;`
		817	`bro(son(son(z))) = cont;`
		818	`if (i != 0) {`
		819	`kill_exp(sz, nilexp);`
		820	`}`
		821	`z = pt(z);`
2	7u83	822
7	7u83	823	`}`
		824	`retcell(addptrset);`
		825	`addptrset = next;`
2	7u83	826	`}`
		827
7	7u83	828	`bro(son(id)) = loop;`
		829	`clearlast(son(id));`
2	7u83	830	`pos = position(loop);`
7	7u83	831	`bro(loop) = id;`
		832	`setlast(loop);`
2	7u83	833	`*pos = id;`
		834
7	7u83	835	`inc = getexp(sh(son(id)), nilexp, 1, nilexp, nilexp, 0,`
		836	`stride * 8 * no(bro(son(bro(son(son(incrset)))))),`
		837	`val_tag);`
2	7u83	838	`ld = getexp(shvar, nilexp, 1, id, pt(id), 0, 0, name_tag);`
7	7u83	839	`pt(id) = ld;`
		840	`no(id) ++;`
		841	`cont = getexp(sh(son(id)), nilexp, 0, ld, nilexp, 0, 0, cont_tag);`
2	7u83	842	`bro(ld) = cont;`
		843	`plus = getexp(sh(cont), nilexp, 1, cont, nilexp, 0, 0, plus_tag);`
		844	`bro(cont) = inc;`
		845	`bro(inc) = plus;`
		846	`dest = getexp(shvar, plus, 0, id, pt(id), 0, 0, name_tag);`
7	7u83	847	`pt(id) = dest;`
		848	`no(id) ++;`
2	7u83	849	`ass = getexp(topsh, nilexp, 1, dest, nilexp, 0, 0, ass_tag);`
		850	`bro(plus) = ass;`
7	7u83	851	`z = getexp(topsh, incr, 0, ass, nilexp, 0, 0, 0);`
2	7u83	852	`bro(ass) = z;`
7	7u83	853	`seq = getexp(topsh, bro(incr), last(incr), z, nilexp, 0, 0, seq_tag);`
2	7u83	854	`pos = position(incr);`
7	7u83	855	`bro(incr) = seq;`
		856	`setlast(incr);`
2	7u83	857	`*pos = seq;`
		858	`}`
		859
		860
7	7u83	861	`exp`
		862	`inner_cont(exp loopbody, exp contset)`
2	7u83	863	`{`
		864
		865	`/*`
7	7u83	866	`son contset = cont(X);`
		867	`pt = next instance`
2	7u83	868	`replace loopbody by Var Z = cont(X) in loopbody(cont(X)/cont(Z))`
		869
		870	`*/`
		871
		872	`exp z = contset;`
		873	`exp *pos;`
		874	`int i;`
		875	`exp id = getexp(sh(loopbody), bro(loopbody), last(loopbody),`
7	7u83	876	`son(contset), nilexp, 1/var/, 0, ident_tag);`
2	7u83	877	`setcaonly(id);`
		878
7	7u83	879	`for (i=0; z != nilexp; i++) {`
		880	`exp ld = getexp(sh(son(son(id))), nilexp, 1, id, pt(id), 0, 0,`
		881	`name_tag);`
		882	`exp cont = getexp(sh(son(id)), bro(son(z)), last(son(z)), ld,`
		883	`nilexp, 0, 0, cont_tag);`
		884	`bro(ld) = cont;`
		885	`pt(id) = ld;`
		886	`no(id) ++;`
2	7u83	887	`pos = position(son(z));`
		888	`*pos = cont;`
7	7u83	889	`if (i != 0) {`
		890	`kill_exp(son(z), nilexp);`
		891	`}`
2	7u83	892	`son(z) = cont;`
		893	`z = pt(z);`
		894	`}`
		895
		896	`pos = position(loopbody);`
7	7u83	897	`bro(son(id)) = loopbody;`
		898	`clearlast(son(id));`
		899	`bro(loopbody) = id;`
		900	`setlast(loopbody);`
2	7u83	901	`*pos = id;`
		902	`return id;`
		903	`}`
		904
7	7u83	905
		906	`exp`
		907	`outer_cont(exp loop, exp contset, exp lastid, exp incr)`
2	7u83	908	`{`
		909
		910	`/*`
7	7u83	911	`son contset = cont(X);`
		912	`pt = next instance`
2	7u83	913	`replace loop by Var Z = cont(x) in`
		914	`loop(cont(x)/cont(Z), incr/{Z=cont(lasttid); incr})`
		915	`returning new iddec`
		916	`*/`
		917
		918	`exp z = contset;`
		919	`exp seq, ld, cont, dest, ass;`
		920	`exp *pos;`
		921	`int i;`
		922	`exp id = getexp(sh(loop), bro(loop), last(loop), son(contset),`
		923	`nilexp, 1/var/, 0, ident_tag);`
		924	`setcaonly(id);`
7	7u83	925	`for (i = 0; z != nilexp; i++) {`
		926	`ld = getexp(sh(son(son(id))), nilexp, 1, id, pt(id), 0, 0,`
		927	`name_tag);`
		928	`cont = getexp(sh(son(id)), bro(son(z)), last(son(z)), ld, nilexp,`
		929	`0, 0, cont_tag);`
		930	`bro(ld) = cont;`
		931	`pt(id) = ld;`
		932	`no(id)++;`
2	7u83	933	`pos = position(son(z));`
		934	`*pos = cont;`
7	7u83	935	`if (i != 0) {`
		936	`kill_exp(son(z), nilexp);`
		937	`}`
2	7u83	938	`son(z) = cont;`
		939	`z = pt(z);`
		940	`}`
		941
		942	`pos = position(loop);`
7	7u83	943	`bro(son(id)) = loop;`
		944	`clearlast(son(id));`
		945	`bro(loop) = id;`
		946	`setlast(loop);`
2	7u83	947	`*pos = id;`
		948
		949
7	7u83	950	`ld = getexp(sh(son(son(id))), nilexp, 1, lastid, pt(lastid), 0, 0,`
		951	`name_tag);`
		952	`pt(lastid) = ld;`
		953	`no(lastid)++;`
		954	`cont = getexp(sh(son(id)), nilexp, 1, ld, nilexp, 0, 0, cont_tag);`
2	7u83	955	`bro(ld) = cont;`
		956	`dest = getexp(sh(son(son(id))), cont, 0, id, pt(id), 0, 0, name_tag);`
7	7u83	957	`pt(id) = dest;`
		958	`no(id)++;`
2	7u83	959	`ass = getexp(topsh, nilexp, 1, dest, nilexp, 0, 0, ass_tag);`
7	7u83	960	`bro(cont) = ass;`
		961	`z = getexp(sh(incr), incr, 0, ass, nilexp, 0, 0, 0);`
2	7u83	962	`bro(ass) = z;`
7	7u83	963	`seq = getexp(sh(incr), bro(incr), last(incr), z, nilexp, 0, 0, seq_tag);`
2	7u83	964	`pos = position(incr);`
7	7u83	965	`bro(incr) = seq;`
		966	`setlast(incr);`
2	7u83	967	`*pos = seq;`
		968
		969	`return id;`
		970	`}`
		971
		972
7	7u83	973	`int`
		974	`unaltered(exp e, int assign_alias)`
2	7u83	975	`{`
		976	`exp z = alteredset;`
		977	`if (name(e) == name_tag && isvar(son(e))) {`
7	7u83	978	`for (; z != nilexp; z = bro(z)) {`
2	7u83	979	`exp dest = son(z);`
7	7u83	980	`Assert(name(dest) == name_tag);`
		981	`if (!isvar(son(dest))) {`
2	7u83	982	`dest = son(son(dest));`
7	7u83	983	`if (name(dest) == reff_tag) {`
		984	`dest = son(dest);`
		985	`}`
2	7u83	986	`Assert(name(dest) == addptr_tag);`
		987	`dest = son(dest);`
		988	`}`
		989	`if (son(e) == son(dest) &&`
7	7u83	990	`(name(son(e)) != proc_tag \|\| no(e) == no(dest))) {`
2	7u83	991	`return false;`
		992	`}`
		993	`}`
		994	`return (iscaonly(son(e)) \|\| !assign_alias);`
		995	`}`
		996	`return false;`
		997	`}`
		998
		999
7	7u83	1000	`int`
		1001	`invariant(exp e, int assign_alias)`
2	7u83	1002	`{`
7	7u83	1003	`return ((name(e) == name_tag) \|\|`
		1004	`(name(e) == cont_tag && unaltered(son(e), assign_alias)));`
2	7u83	1005	`}`
		1006
		1007
		1008	`static int multiplier; /part of answer to weaken /`
		1009	`static int arraystep; /part of answer to weaken /`
		1010
7	7u83	1011	`int`
		1012	`weaken(exp loop, exp addptrset, exp incrset)`
2	7u83	1013	`{`
		1014	`/* applies strength reduction to addptrs in addptrset and`
		1015	`delivers the multiplying factor if suitable for unwinding`
		1016	`otherwise 0`
		1017	`*/`
		1018	`exp incr = son(incrset);`
		1019	`exp addptr = son(addptrset);`
		1020	`int inci = no(bro(son(bro(son(incr)))));`
		1021	`exp minc = bro(son(addptr));`
		1022	`int simple_c = 0;`
		1023	`int res = -1;`
7	7u83	1024	`if (name(minc) == cont_tag) {`
2	7u83	1025	`multiplier = inci;`
		1026	`arraystep = 1;`
		1027	`simple_c = 1;`
7	7u83	1028	`} else {`
		1029	`arraystep = no(bro(son(minc))) >> 3;`
		1030	`multiplier = inci * arraystep;`
2	7u83	1031	`}`
7	7u83	1032
		1033	`if (!invariant(son(addptr), assign_alias) \|\| no(incrset) != 1) {`
		1034	`return 0;`
2	7u83	1035	`}`
7	7u83	1036	`if (props(addptrset) && unaltered(son(addptr), assign_alias)) {`
		1037	`res = 1;`
		1038	`}`
2	7u83	1039
7	7u83	1040	`extract_addptrs(incr, addptrset, loop, bro(son(minc)), inci, simple_c);`
2	7u83	1041	`return res;`
		1042	`}`
		1043
7	7u83	1044
		1045	`struct en{`
		1046	`exp e;`
		1047	`int disp;`
2	7u83	1048	`};`
		1049
7	7u83	1050	`int`
		1051	`unwind(exp loop, exp contset, exp incr, int incval)`
2	7u83	1052	`{`
		1053	`exp body = bro(son(bro(son(loop))));`
7	7u83	1054	`int i, j;`
2	7u83	1055	`exp z = contset;`
		1056	`int n = no(contset);`
		1057	`int insts = 0;`
7	7u83	1058	`struct en s = (struct en )xcalloc(n, sizeof(struct en));`
		1059	`for (i=0; i<n; i++) {`
2	7u83	1060	`/* sort cont([reff (disp) cont(X)) into s */`
		1061	`exp c = son(z);`
		1062	`exp w;`
		1063	`int n;`
		1064	`exp next = pt(z);`
7	7u83	1065	`Assert(name(c) == cont_tag);`
		1066	`if (!last(c)) {`
		1067	`z = next;`
		1068	`continue;`
2	7u83	1069	`}`
7	7u83	1070	`if (name(bro(c)) == cont_tag) {`
		1071	`n = 0;`
		1072	`w = bro(c);`
		1073	`} else if (name(bro(c)) == reff_tag && last(bro(c)) &&`
		1074	`name(bro(bro(c))) == cont_tag) {`
		1075	`n = no(bro(c));`
		1076	`w = bro(bro(c));`
		1077	`} else {`
		1078	`z= next;`
		1079	`continue;`
		1080	`}`
2	7u83	1081
7	7u83	1082	`son(z) = w;`
2	7u83	1083
7	7u83	1084	`for (j=0; j <insts; j++) {`
2	7u83	1085	`int d = s[j].disp;`
7	7u83	1086	`if (d == n) {`
		1087	`break;`
		1088	`}`
		1089	`if ((incval > 0 && d < n) \|\| (incval < 0 && d > n)) {`
		1090	`/make a hole at jth position /`
2	7u83	1091	`int k;`
7	7u83	1092	`for (k = insts - 1; k >= j; k--) {`
		1093	`s[k + 1] = s[k];`
2	7u83	1094	`}`
		1095	`s[j].e = nilexp;`
		1096	`insts++;`
		1097	`break;`
		1098	`}`
		1099	`}`
7	7u83	1100	`if (j == insts) {`
		1101	`/* add another */`
2	7u83	1102	`insts++;`
		1103	`s[j].e = nilexp;`
		1104	`};`
		1105	`pt(z) = s[j].e;`
		1106	`s[j].e = z;`
		1107	`s[j].disp= n;`
		1108	`z = next;`
		1109	`}`
7	7u83	1110	`if (insts == 0) {`
		1111	`return false;`
		1112	`}`
2	7u83	1113	`z = nilexp;`
		1114
		1115	`for (i = 0; i < insts; i++) {`
7	7u83	1116	`if (no(s[i].e) > 1) {`
		1117	`z = inner_cont(body, s[i].e);`
2	7u83	1118	`}`
7	7u83	1119	`for (; i < insts-1 && s[i].disp - incval * 8 == s[i+1].disp;`
		1120	`i++) {`
		1121	`if (z == nilexp) {`
		1122	`z = inner_cont(body, s[i].e);`
		1123	`}`
		1124	`z = outer_cont(loop, s[i + 1].e, z, son(incr));`
		1125	`}`
2	7u83	1126	`z= nilexp;`
		1127	`}`
		1128
		1129	`return true;`
		1130	`}`
		1131
7	7u83	1132
		1133	`int`
		1134	`all_before(exp addptrset, exp inc, exp body)`
2	7u83	1135	`{`
		1136	`exp z=inc;`
		1137	`exp w;`
7	7u83	1138	`while (z != body) {`
2	7u83	1139	`exp b = bro(z);`
7	7u83	1140	`if (!last(z)) {`
		1141	`for (w=addptrset; w != nilexp; w= pt(w)) {`
		1142	`/* son(w) is internal to body - is it in bro(z) ?`
		1143	`* ie after z*/`
		1144	`exp s = son(w);`
		1145	`while (s != body && s != b) {`
		1146	`s = father(s);`
		1147	`}`
		1148	`if (s == b) {`
		1149	`return false;`
		1150	`}`
		1151	`}`
2	7u83	1152	`}`
		1153	`z = b;`
		1154	`}`
7	7u83	1155	`return true;`
2	7u83	1156	`}`
		1157
		1158
7	7u83	1159	`void`
		1160	`replace_var(exp ldcpy, exp loop, shape shcont)`
2	7u83	1161	`{`
		1162	`/* ld is copy of the name(id) assigned to safely in loop`
		1163	`(see do_one_rep)`
		1164	`replace loop(id) by Var x := cont(id) in loop(x); id = cont(x) ni;`
		1165	`*/`
		1166	`exp z;`
7	7u83	1167	`exp *pos;`
		1168	`exp ld = getexp(sh(ldcpy), nilexp, 1, son(ldcpy), pt(son(ldcpy)),`
		1169	`props(ldcpy), no(ldcpy), name(ldcpy));`
2	7u83	1170	`exp def = getexp(shcont, nilexp, 0, ld, nilexp, 0, 0, cont_tag);`
7	7u83	1171	`exp varid = getexp(sh(loop), bro(loop), last(loop), def, nilexp,`
		1172	`subvar \| 1 /var/, 1, ident_tag);`
2	7u83	1173	`exp ldvar = getexp(sh(ld), nilexp, 1, varid, nilexp, 0, 0, name_tag);`
7	7u83	1174	`exp contvar = getexp(shcont, nilexp, 1, ldvar, nilexp, 0, 0, cont_tag);`
		1175	`exp nld = getexp(sh(ld), contvar, 0, son(ld), ld, 0, no(ld), name_tag);`
		1176	`exp ass = getexp(topsh, nilexp, 1, nld, nilexp, 0, 0, ass_tag);`
2	7u83	1177	`exp seqh = getexp(topsh, ass, 0, loop, nilexp, 0, 0, 0);`
		1178	`exp seq = getexp(topsh, varid, 1, seqh, nilexp, 0, 0, seq_tag);`
		1179	`bro(ass) = seq; /father/`
		1180	`bro(contvar) = ass;/father/`
		1181	`bro(ldvar) = contvar;/father/`
		1182	`bro(ld) = def; /* father */`
7	7u83	1183	`pt(son(ld)) = nld;`
		1184	`no(son(ld)) += 2; /* two new used of id */`
2	7u83	1185	`bro(def) = seq;`
		1186	`pt(varid) = ldvar;`
		1187	`setcaonly(varid);`
		1188
		1189	`/* now relpace all old uses of ld in loop by varid */`
7	7u83	1190	`for (z = pt(ld); z != nilexp; z = pt(z)) {`
		1191	`if (no(z) == no(ld) && intnl_to(loop, z)) {`
2	7u83	1192	`/* ALTERATION #1 */`
		1193	`exp lu = getexp(sh(z), bro(z), last(z), varid, pt(varid), 0,`
7	7u83	1194	`0, name_tag);`
2	7u83	1195	`pos = position(z);`
7	7u83	1196	`pt(varid) = lu;`
		1197	`no(varid) ++;`
2	7u83	1198	`kill_exp(z, nilexp); /* this should not kill the def of ld! */`
		1199	`*pos = lu;`
		1200	`}`
		1201	`}`
		1202	`pos = position(loop);`
		1203	`*pos = varid;`
7	7u83	1204	`bro(loop) = seqh;`
		1205	`setlast(loop);`
2	7u83	1206	`}`
		1207
		1208
7	7u83	1209	`exp`
		1210	`limexp(exp test, exp ld)`
2	7u83	1211	`{`
		1212	`exp lh = son(test);`
		1213	`exp rh = bro(lh);`
7	7u83	1214	`if (name(lh) == cont_tag && name(son(lh)) == name_tag &&`
		1215	`son(son(lh)) == son(ld) && no(son(lh)) == no(ld)) {`
		1216	`return rh;`
		1217	`}`
2	7u83	1218
7	7u83	1219	`if (name(rh) == cont_tag && name(son(rh)) == name_tag &&`
		1220	`son(son(rh)) == son(ld) && no(son(rh)) == no(ld)) {`
		1221	`return lh;`
		1222	`}`
2	7u83	1223	`return nilexp;`
		1224	`}`
		1225
7	7u83	1226	`exp`
		1227	`limaddptr(exp arr, exp val, int m)`
2	7u83	1228	`{`
		1229	`exp naddptr = getexp(sh(arr), nilexp, 0, copy(arr), nilexp, 0, 0,`
7	7u83	1230	`addptr_tag);`
2	7u83	1231	`exp z, v;`
		1232	`shape s;`
7	7u83	1233	`if (m == 1) {`
2	7u83	1234	`z = copy(val);`
7	7u83	1235	`bro(z) = naddptr;`
		1236	`setlast(z);`
		1237	`} else {`
		1238	`s = f_offset(al1_of(sh(naddptr)), al1_of(sh(naddptr)));`
		1239	`z = getexp(s, naddptr, 1, copy(val), nilexp, 0, 0, offset_mult_tag);`
2	7u83	1240	`v = getexp(s, z, 1, nilexp, nilexp, 0, m*8, val_tag);`
7	7u83	1241	`bro(son(z)) = v;`
		1242	`clearlast(son(z));`
2	7u83	1243	`}`
7	7u83	1244	`bro(son(naddptr)) = z;`
		1245	`clearlast(son(naddptr));`
2	7u83	1246	`return naddptr;`
7	7u83	1247	`/* a new addptr with index replaced by val - used in limdec*/`
2	7u83	1248	`}`
		1249
7	7u83	1250	`exp`
		1251	`limmult(exp arr, exp val, int m)`
2	7u83	1252	`{`
		1253	`exp naddptr = getexp(sh(son(arr)), nilexp, 0, copy(val), nilexp, 0, 0,`
7	7u83	1254	`mult_tag);`
2	7u83	1255	`exp v = getexp(sh(son(arr)), nilexp, 1, nilexp, nilexp, 0, m, val_tag);`
		1256	`bro(v) = naddptr;`
7	7u83	1257	`bro(son(naddptr)) = v;`
		1258	`clearlast(son(naddptr));`
2	7u83	1259	`return naddptr;`
7	7u83	1260	`/* a new addptr with index replaced by val - used in limdec*/`
2	7u83	1261	`}`
		1262
7	7u83	1263
		1264	`exp`
		1265	`limreff(exp arr, int bytedisp)`
2	7u83	1266	`{`
7	7u83	1267	`if (bytedisp != 0) {`
		1268	`exp nreff = getexp(sh(arr), nilexp, 0, copy(arr), nilexp, 0,`
		1269	`bytedisp * 8, reff_tag);`
		1270	`bro(son(nreff)) = nreff;`
		1271	`setlast(son(nreff));`
		1272	`return nreff;`
		1273	`} else {`
		1274	`return copy(arr);`
		1275	`}`
2	7u83	1276	`}`
		1277
7	7u83	1278	`exp`
		1279	`limconst(exp arr, int bytedisp)`
2	7u83	1280	`{`
7	7u83	1281	`exp nreff = getexp(/sh(son(arr))/slongsh, nilexp, 1, nilexp, nilexp,`
		1282	`0, bytedisp, val_tag);`
2	7u83	1283	`UNUSED(arr);`
		1284	`bro(nreff) = nreff;`
		1285	`return nreff;`
		1286	`}`
		1287
7	7u83	1288
		1289	`exp`
		1290	`limdec(exp adec, exp val, int mult)`
2	7u83	1291	`{`
		1292	`exp init = son(adec);`
		1293	`exp bdy = bro(init);`
7	7u83	1294	`exp ninit = (name(val) != val_tag) ? limaddptr(son(init), val, mult) :`
		1295	`limreff(son(init), mult * no(val));`
2	7u83	1296	`exp nb = getexp(sh(bdy), adec, 1, ninit, nilexp, 0, 0, ident_tag);`
7	7u83	1297	`bro(ninit) = bdy;`
		1298	`clearlast(ninit);`
		1299	`bro(bdy) = nb;`
		1300	`setlast(bdy);`
2	7u83	1301	`bro(init) = nb;`
		1302	`return nb; /* the declaration of the limit value */`
		1303	`}`
		1304
7	7u83	1305
		1306	`exp`
		1307	`limdec2(exp adec, exp val, int mult)`
2	7u83	1308	`{`
		1309	`exp init = son(adec);`
		1310	`exp bdy = bro(init);`
7	7u83	1311	`exp ninit = (name(val) != val_tag) ? limmult(son(init), val, mult) :`
		1312	`limconst(son(init), mult * no(val));`
2	7u83	1313	`exp nb = getexp(sh(bdy), adec, 1, ninit, nilexp, 0, 0, ident_tag);`
7	7u83	1314	`bro(ninit) = bdy;`
		1315	`clearlast(ninit);`
		1316	`bro(bdy) = nb;`
		1317	`setlast(bdy);`
2	7u83	1318	`bro(init) = nb;`
		1319	`return nb; /* the declaration of the limit value */`
		1320	`}`
		1321
		1322
7	7u83	1323	`void`
		1324	`remove_incr(exp adec, exp test, exp incr, int mult)`
2	7u83	1325	`{`
		1326	`exp le = limexp(test, son(incr));`
7	7u83	1327	`exp *pos;`
2	7u83	1328	`exp ndec = limdec(adec, le, mult);`
		1329	`exp lda = getexp(f_pointer(long_to_al(shape_align(sh(son(adec))))),`
		1330	`nilexp, 1, adec, pt(adec), 0, 0, name_tag);`
7	7u83	1331	`exp clda = getexp(sh(son(adec)), nilexp, 0, lda, nilexp, 0, 0,`
		1332	`cont_tag);`
		1333	`exp ldn = getexp(sh(son(ndec)), nilexp, 0, ndec, pt(ndec), 0, 0,`
		1334	`name_tag);`
		1335	`exp ntestx = getexp(sh(test), bro(test), last(test), nilexp, pt(test),`
		1336	`props(test), no(test), name(test));`
		1337	`bro(lda) = clda;`
		1338	`pt(adec) = lda;`
		1339	`no(adec)++;`
		1340	`pt(ndec) = ldn;`
		1341	`no(ndec)++;`
2	7u83	1342	`if (last(le)) {`
		1343	`son(ntestx) = clda;`
7	7u83	1344	`bro(clda) = ldn;`
		1345	`clearlast(clda);`
		1346	`bro(ldn) = ntestx;`
		1347	`setlast(ldn);`
		1348	`} else {`
		1349	`son(ntestx) = ldn;`
		1350	`bro(ldn) = clda;`
		1351	`clearlast(ldn);`
		1352	`bro(clda) = ntestx;`
		1353	`setlast(clda);`
2	7u83	1354	`}`
		1355	`pos = position(test);`
		1356	`*pos = ntestx;`
		1357	`kill_exp(test, nilexp);`
		1358	`setname(incr, top_tag);`
		1359	`kill_exp(bro(son(incr)), nilexp);`
		1360	`kill_exp(son(incr), nilexp);`
		1361	`son(incr) = nilexp;`
		1362	`}`
		1363
7	7u83	1364
		1365	`void`
		1366	`remove_incr2(exp adec, exp test, exp incr, int mult)`
2	7u83	1367	`{`
		1368	`exp le = limexp(test, son(incr));`
7	7u83	1369	`exp *pos;`
2	7u83	1370	`exp init = son(adec);`
		1371	`exp bdy = bro(init);`
7	7u83	1372	`exp ninit, ldn, ntestx, lda, clda;`
		1373	`if (name(le) != val_tag && !remove_unused_index_counters) {`
2	7u83	1374	`return;`
7	7u83	1375	`}`
		1376	`lda = getexp(f_pointer(long_to_al(shape_align(sh(son(adec))))), nilexp,`
		1377	`1, adec, pt(adec), 0, 0, name_tag);`
		1378	`clda = getexp(/sh(son(adec))/slongsh, nilexp, 0, lda, nilexp, 0, 0,`
		1379	`cont_tag);`
		1380	`if (name(le) == val_tag) {`
		1381	`ninit = limconst(son(init), mult*no(le));`
		1382	`ldn = ninit;`
		1383	`} else {`
		1384	`exp nb;`
		1385	`ninit = limmult(son(init), le, mult);`
		1386	`nb = getexp(sh(bdy), adec, 1, ninit, nilexp, 0, 0, ident_tag);`
		1387	`bro(ninit) = bdy;`
		1388	`clearlast(ninit);`
		1389	`bro(bdy) = nb;`
		1390	`setlast(bdy);`
		1391	`bro(init) = nb;`
		1392	`ninit = nb;`
		1393	`ldn = getexp(sh(son(ninit)), nilexp, 0, ninit, pt(ninit), 0, 0,`
		1394	`name_tag);`
		1395	`pt(ninit) = ldn;`
		1396	`no(ninit)++;`
		1397	`}`
		1398	`ntestx = getexp(sh(test), bro(test), last(test), nilexp, pt(test),`
		1399	`props(test), no(test), name(test));`
		1400	`bro(lda) = clda;`
		1401	`pt(adec) = lda;`
		1402	`no(adec)++;`
2	7u83	1403	`if (last(le)) {`
		1404	`son(ntestx) = clda;`
7	7u83	1405	`bro(clda) = ldn;`
		1406	`clearlast(clda);`
		1407	`bro(ldn) = ntestx;`
		1408	`setlast(ldn);`
		1409	`} else {`
		1410	`son(ntestx) = ldn;`
		1411	`bro(ldn) = clda;`
		1412	`clearlast(ldn);`
		1413	`bro(clda) = ntestx;`
		1414	`setlast(clda);`
2	7u83	1415	`}`
		1416	`pos = position(test);`
		1417	`*pos = ntestx;`
		1418	`kill_exp(test, nilexp);`
		1419	`setname(incr, top_tag);`
		1420	`kill_exp(bro(son(incr)), nilexp);`
		1421	`kill_exp(son(incr), nilexp);`
		1422	`son(incr) = nilexp;`
		1423	`}`
		1424
7	7u83	1425
		1426	`int`
		1427	`use_in(exp w, exp ld)`
2	7u83	1428	`{`
7	7u83	1429	`switch (name(w)) {`
		1430	`case name_tag:`
		1431	`return (son(w) == son(ld) && no(w) == no(ld));`
2	7u83	1432	`case ass_tag: {`
7	7u83	1433	`int z = use_in(bro(son(w)), ld);`
		1434	`if (z != 0) {`
		1435	`return z;`
		1436	`}`
		1437	`if (name(son(w)) == name_tag && son(son(w)) == son(ld) &&`
		1438	`no(son(w)) == no(ld)) {`
		1439	`return -1;`
		1440	`}`
		1441	`return use_in(son(w), ld);`
2	7u83	1442	`}`
7	7u83	1443	`case goto_tag:`
		1444	`case case_tag:`
		1445	`case test_tag:`
		1446	`case testbit_tag:`
		1447	`case labst_tag:`
		1448	`return 1;`
2	7u83	1449	`default: {`
7	7u83	1450	`exp z = son(w);`
		1451	`if (z == nilexp) {`
		1452	`return 0;`
		1453	`}`
		1454	`for (;;) {`
		1455	`int a = use_in(z, ld);`
		1456	`if (a != 0 \|\| last(z)) {`
		1457	`return a;`
		1458	`}`
		1459	`z = bro(z);`
		1460	`}`
2	7u83	1461	`}`
7	7u83	1462	`}`
2	7u83	1463	`}`
		1464
		1465
7	7u83	1466	`int`
		1467	`suitable_test(exp tests, exp incrld, exp loop)`
2	7u83	1468	`{`
		1469	`/* is test such that one can remove the increment ? */`
		1470	`exp t, p;`
		1471	`exp decx = son(incrld);`
		1472	`exp v;`
7	7u83	1473	`if (tests == nilexp \|\| no(tests) != 1 \|\| bro(tests) != nilexp) {`
		1474	`return 0;`
		1475	`}`
2	7u83	1476	`t = son(tests);`
		1477	`v = limexp(t, incrld);`
7	7u83	1478	`if (name(v) != val_tag &&`
		1479	`(!invariant(v, assign_alias) \|\| maybe_incr(v))) {`
		1480	`return 0;`
		1481	`}`
		1482	`while (t != loop && last(t)) {`
		1483	`t= bro(t);`
		1484	`}`
		1485	`if (t != loop) {`
		1486	`return 0;`
		1487	`}`
		1488	`while (name(t) != proc_tag && t != decx) {`
		1489	`exp b = bro(t);`
		1490	`if (!last(t)) {`
		1491	`for (p = pt(decx); p != nilexp; p = pt(p)) {`
		1492	`if (intnl_to(b, p) && use_in(b, incrld) == 1) {`
		1493	`return 0;`
		1494	`}`
		1495	`}`
2	7u83	1496	`}`
7	7u83	1497	`t = b;`
2	7u83	1498	`}`
		1499	`return 1;`
		1500	`}`
		1501
		1502
7	7u83	1503	`int`
		1504	`do_one_rep(exp loop)`
2	7u83	1505	`{`
		1506	`exp body = bro(son(bro(son(loop))));`
7	7u83	1507	`exp z;`
2	7u83	1508	`int res =0;`
		1509	`exp xincrs;`
7	7u83	1510	`Assert(name(loop) == rep_tag);`
		1511	`incrs = nilexp;`
		1512	`alteredset=nilexp;`
		1513	`assign_alias = false;`
		1514	`jump_out = false;`
		1515	`scan_for_incr(body, loop, collect_incrs);`
		1516	`if (!jump_out && name(sh(loop)) == tophd) {`
		1517	`for (z = alteredset; z != nilexp; z = bro(z)) {`
		1518	`/* look to see if var assigned to in loop can be`
		1519	`* locally declared ie Rep f(z) => Var x := cont(z) in`
		1520	`* Rep f(x); z = cont x ni; ? only worth while if z is`
		1521	`* global if z is local only worthwhile if it isnt`
		1522	`* being allocated in reg anyway`
		1523	`*/`
		1524	`exp a = son(z);`
2	7u83	1525
7	7u83	1526	`if (name(a) == name_tag &&`
		1527	`(isglob(son(a)) \|\| !isvar(son(a))) &&`
		1528	`(props(son(a)) & subvar) == 0 &&`
		1529	`(!assign_alias \|\|`
		1530	`(isvar(son(a)) && iscaonly(son(a)))) &&`
		1531	`!intnl_to(body, son(a))) {`
		1532	`exp p;`
		1533	`exp dc = son(a);`
		1534	`shape shcont;`
		1535	`int const_init = !isglob(dc) &&`
		1536	`(name(son(dc)) == clear_tag \|\|`
		1537	`name(son(dc)) == val_tag \|\|`
		1538	`name(son(dc)) == real_tag \|\|`
		1539	`(name(son(dc)) == name_tag &&`
		1540	`!isvar(son(son(dc)))));`
		1541	`for (p = pt(son(a)); p != nilexp; p = pt(p)) {`
2	7u83	1542	`#ifdef NEWDIAGS`
7	7u83	1543	`int inb;`
		1544	`if (isdiaginfo(p)) {`
		1545	`continue;`
		1546	`}`
		1547	`inb = intnl_to(body, p);`
2	7u83	1548	`#else`
7	7u83	1549	`int inb = intnl_to(body, p);`
2	7u83	1550	`#endif`
7	7u83	1551	`if (!inb) {`
		1552	`const_init = 0;`
		1553	`continue;`
		1554	`}`
		1555	`if (no(a) != no(p)) {`
		1556	`break;`
		1557	`}`
		1558	`if (last(p) &&`
		1559	`name(bro(p)) == cont_tag) {`
		1560	`shcont = sh(bro(p));`
		1561	`continue;`
		1562	`}`
		1563	`if (!last(p) && last(bro(p)) &&`
		1564	`name(bro(bro(p))) == ass_tag) {`
		1565	`shcont = sh(bro(p));`
		1566	`continue;`
		1567	`}`
		1568	`break;`
		1569	`}`
		1570	`if (p != nilexp) {`
		1571	`continue;`
		1572	`}`
		1573	`/* only uses of this id is cont or assign in`
		1574	`* body */`
		1575	`if (!isvar(son(a))) {`
		1576	`/*check to see whether underlying id is`
		1577	`* used in loop*/`
		1578	`exp w = son(son(a));`
		1579	`const_init = 0;`
		1580	`if (name(w) == reff_tag) {`
		1581	`w = son(w);`
		1582	`}`
		1583	`Assert(name(w) == addptr_tag);`
		1584	`/* uses of underlying var */`
		1585	`w = pt(son(son(w)));`
		1586
		1587	`for (; w != nilexp; w= pt(w)) {`
		1588	`if (intnl_to(body, w)) {`
		1589	`break;`
		1590	`}`
		1591	`}`
		1592	`if (w != nilexp) {`
		1593	`continue;`
		1594	`}`
		1595	`}`
		1596	`if (const_init) {`
		1597	`/* can reduce scope of altered`
		1598	`* variable */`
		1599	`exp dc= son(a);`
		1600	`exp bd = bro(son(dc));`
		1601	`if (bd != loop &&`
		1602	`name(dc) == ident_tag) {`
		1603	`exp brodc = bro(dc);`
		1604	`int ldc = last(dc);`
		1605	`exp broloop = bro(loop);`
		1606	`int lloop = last(loop);`
		1607	`exp *pos = position(dc);`
		1608	`*pos = bd;`
		1609	`/* replace original dec with`
		1610	`* its body.*/`
		1611	`bro(bd) = brodc;`
		1612	`if (ldc) {`
		1613	`setlast(bd);`
		1614	`} else {`
		1615	`clearlast(bd);`
		1616	`}`
		1617	`/* ... and set bro to that of`
		1618	`* dec */`
		1619	`pos = position(loop);`
		1620	`/* replace loop by dec */`
		1621	`*pos = dc;`
		1622
		1623	`bro(dc) = broloop;`
		1624	`if (lloop) {`
		1625	`setlast(dc);`
		1626	`} else {`
		1627	`clearlast(dc);`
		1628	`}`
		1629	`/* ... set bro to that of loop,`
		1630	`* ... */`
		1631	`bro(son(dc)) = loop;`
		1632	`bro(loop) = dc;`
		1633	`setlast(loop);`
		1634	`/* ... and make loop be body of`
		1635	`* dec */`
		1636	`}`
		1637	`} else {`
		1638	`/* CHECK THIS: why is it set? */`
		1639	`SET(shcont);`
		1640
		1641	`replace_var(a, loop, shcont);`
		1642	`}`
		1643	`res = true;`
2	7u83	1644	`}`
		1645	`}`
		1646	`}`
		1647	`xincrs = incrs;`
7	7u83	1648	`while (xincrs != nilexp) {`
		1649	`exp incrld = son(son(xincrs));`
		1650	`exp nincr = bro(xincrs);`
		1651	`int ou;`
		1652	`exp adec = nilexp;`
		1653	`int elsize;`
		1654	`exp incrdec = son(incrld);`
		1655	`tests = nilexp;`
		1656	`addptrs = nilexp;`
		1657	`stride = 0;`
		1658	`ou=find_common_index(incrld, body, collect_loopthings);`
		1659	`if (stride < 1) {`
		1660	`exp t;`
		1661	`int i;`
		1662	`int nap = 0;`
		1663	`tests=nilexp;`
		1664	`addptrs=nilexp;`
		1665	`stride = 0;`
		1666	`ou = find_pointer_opt(incrld, body, collect_loopthings);`
		1667	`for (i = 0, t = addptrs; t != nilexp; i++, t = bro(t)) {`
		1668	`nap += no(t);`
2	7u83	1669	`}`
7	7u83	1670	`if (i >= 3 && i == nap) {`
		1671	`/* don't replace all addptrs if too many vars`
		1672	`* required ... */`
		1673	`if (stride > 1) {`
		1674	`/* ... but can still scale index */`
		1675	`scale_loopid(loop, addptrs, xincrs);`
		1676	`/* only other uses besides addptr &`
		1677	`* test are in increment */`
		1678	`if (ou == 2 &&`
		1679	`suitable_test(tests,`
		1680	`son(son(xincrs)),`
		1681	`loop)) {`
		1682	`remove_incr2(bro(loop),`
		1683	`son(tests),`
		1684	`son(xincrs),`
		1685	`stride);`
		1686	`}`
		1687	`}`
		1688	`ou += nap;`
		1689	`addptrs = nilexp;`
		1690	`}`
		1691	`while (addptrs != nilexp) {`
		1692	`int rw = weaken(loop, addptrs, xincrs);`
		1693	`exp next = bro(addptrs);`
		1694	`if (rw != 0) {`
		1695	`res = true;`
		1696	`/* really father put in by weaken */`
		1697	`adec = bro(loop);`
		1698	`elsize = arraystep;`
		1699	`} else {`
		1700	`SET(elsize);`
		1701	`ou+=no(addptrs);`
		1702	`}`
		1703	`if (rw > 0) {`
		1704	`/* there is only one incr and it is`
		1705	`* safe to replace conts; however don't`
		1706	`* know whether increment is before`
		1707	`* uses - could make store-exception if`
		1708	`* it isn't */`
		1709	`if (all_before(addptrs,`
		1710	`son(xincrs), body) &&`
		1711	`multiplier != 0) {`
		1712	`IGNORE unwind(loop, addptrs,`
		1713	`xincrs,`
		1714	`multiplier);`
		1715	`}`
		1716	`}`
		1717	`retcell(addptrs);`
		1718	`addptrs=next;`
		1719	`}`
2	7u83	1720
7	7u83	1721	`/* only other uses (besides addptr & test) of loop var`
		1722	`* is in increment */`
		1723	`if (ou == 2 && adec != nilexp &&`
		1724	`suitable_test(tests, incrld, loop) &&`
		1725	`multiplier != 0 && remove_unused_counters) {`
		1726	`remove_incr(adec, son(tests), son(xincrs),`
		1727	`elsize);`
		1728	`}`
		1729	`} else if (stride > 1) {`
		1730	`scale_loopid(loop, addptrs, xincrs);`
		1731	`/* only other uses besides addptr & test are in`
		1732	`* increment*/`
		1733	`if (ou == 2 &&`
		1734	`suitable_test(tests, son(son(xincrs)), loop)) {`
		1735	`remove_incr2(bro(loop), son(tests), son(xincrs),`
		1736	`stride);`
		1737	`}`
2	7u83	1738	`}`
		1739
7	7u83	1740	`/* avoid n-squared factor */`
		1741	`if (res && no(incrdec) < 10) {`
		1742	`IGNORE check_id(incrdec, bro(son(incrdec)));`
		1743	`}`
2	7u83	1744
7	7u83	1745	`xincrs=nincr;`
2	7u83	1746	`}`
7	7u83	1747	`while (incrs != nilexp) {`
2	7u83	1748	`exp z = bro(incrs);`
		1749	`retcell(incrs);`
		1750	`incrs = z;`
		1751	`}`
7	7u83	1752	`while (alteredset != nilexp) {`
		1753	`exp z = bro(alteredset);`
		1754	`retcell(son(alteredset));`
		1755	`retcell(alteredset);`
		1756	`alteredset = z;`
		1757	`}`
2	7u83	1758	`return res;`
		1759	`}`
		1760
7	7u83	1761
		1762	`void`
		1763	`order_loops(exp reps)`
2	7u83	1764	`{`
		1765	`/* start at outer loop ?! */`
7	7u83	1766	`if ((props(reps) & 0x80) == 0) {`
		1767	`if (bro(reps) != nilexp) {`
		1768	`order_loops(bro(reps));`
		1769	`}`
		1770	`if (son(reps) != nilexp && name(son(reps)) == rep_tag &&`
		1771	`no(reps) < max_loop_depth) {`
		1772	`exp loop = son(reps);`
		1773	`/* ALTERATION #2 - does not effect C */`
		1774	`if (name(son(loop)) != top_tag) {`
		1775	`/* make loop(st, b) into seq((st),`
		1776	`* loop(make_top, b)) analysis assumes`
		1777	`* son(loop) = top! */`
		1778	`exp st = son(loop);`
		1779	`exp b = bro(st);`
		1780	`exp * pos = ifc_ptr_position(loop);`
		1781	`exp mt = getexp(f_top, b, 0, nilexp, nilexp, 0,`
		1782	`0, top_tag);`
		1783	`exp sl = getexp(f_top, loop, 0 ,st, nilexp, 0,`
		1784	`0, 0);`
		1785	`exp s = getexp(sh(loop), bro(loop), last(loop),`
		1786	`sl, nilexp, 0, 0, seq_tag);`
2	7u83	1787
7	7u83	1788	`bro(st) = sl;`
		1789	`setlast(st);`
		1790	`son(loop) = mt;`
		1791	`bro(loop) = s;`
		1792	`setlast(loop);`
		1793	`*pos = s;`
		1794	`}`
		1795	`IGNORE do_one_rep(loop);`
		1796	`}`
2	7u83	1797	`props(reps) \|=0x80;`
		1798	`}`
		1799	`}`
		1800
7	7u83	1801
		1802	`void`
		1803	`forall_opt(void)`
2	7u83	1804	`{`
7	7u83	1805	`exp reps = get_repeats();`
2	7u83	1806	`while (reps != nilexp) {`
		1807	`order_loops(reps);`
		1808	`reps = pt(reps);`
		1809	`}`
7	7u83	1810	`if (do_loopconsts) {`
		1811	`do_foralls = false;`
		1812	`/* try constant extraction again */`
		1813	`repeat_consts();`
		1814	`}`
2	7u83	1815	`}`

Subversion Repositories tendra.SVN

(root)/trunk/src/installers/common/construct/foralls.c – Rev 7