WebSVN – tendra.SVN – Blame – /branches/algol60/src/installers/alpha/common/scan.c

Rev	Author	Line No.	Line
2	7u83	1	`/*`
7	7u83	2	`* Copyright (c) 2002-2005 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`
7	7u83	33
2	7u83	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:-`
7	7u83	42
2	7u83	43	`(1) Its Recipients shall ensure that this Notice is`
		44	`reproduced upon any copies or amended versions of it;`
7	7u83	45
2	7u83	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;`
7	7u83	49
2	7u83	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;`
7	7u83	53
2	7u83	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
7	7u83	61	`/* $Id$ */`
2	7u83	62
		63	`#ifndef lint`
7	7u83	64	`static char vcid[] = "$Id$";`
2	7u83	65	`#endif /* lint */`
		66
		67	`/*`
		68	$Log: scan.c,v $
		69	`* Revision 1.1.1.1 1998/01/17 15:56:01 release`
		70	`* First version to be checked into rolling release.`
		71	`*`
		72	`* Revision 1.31 1997/09/05 12:23:20 john`
		73	`* bugfix`
		74	`*`
		75	`* Revision 1.29 1996/03/15 10:29:12 john`
		76	`* Fixed bug in apply_general_tag`
		77	`*`
		78	`* Revision 1.28 1996/02/29 17:36:36 john`
		79	`* Fix to shift op`
		80	`*`
		81	`* Revision 1.27 1996/02/19 09:25:23 john`
		82	`* Fixed postlude with call`
		83	`*`
		84	`* Revision 1.26 1996/02/15 09:57:48 john`
		85	`* Fixed bug in allocation of space for integer to floating point`
		86	`* conversion.`
		87	`*`
		88	`* Revision 1.25 1996/01/23 16:58:30 john`
		89	`* Fix to general procs`
		90	`*`
		91	`* Revision 1.24 1995/12/04 09:13:42 john`
		92	`* Removed code`
		93	`*`
		94	`* Revision 1.23 1995/11/14 15:37:21 john`
		95	`* Fixes to general procs`
		96	`*`
		97	`* Revision 1.22 1995/11/13 12:43:50 john`
		98	`* Added prof_tag case`
		99	`*`
		100	`* Revision 1.21 1995/09/29 15:53:17 john`
		101	`* Some changes for vcallers`
		102	`*`
		103	`* Revision 1.20 1995/09/20 10:46:58 john`
		104	`* Added trap_tag`
		105	`*`
		106	`* Revision 1.19 1995/09/13 16:33:49 john`
		107	`* Added special_tag`
		108	`*`
		109	`* Revision 1.18 1995/09/04 16:24:18 john`
		110	`* Fix to general procs`
		111	`*`
		112	`* Revision 1.17 1995/08/31 15:47:39 john`
		113	`* Added fmax_tag`
		114	`*`
		115	`* Revision 1.16 1995/08/30 16:15:12 john`
		116	`* Fix to diagnostics`
		117	`*`
		118	`* Revision 1.15 1995/08/23 16:06:26 john`
		119	`* Fix to compound_tag`
		120	`*`
		121	`* Revision 1.14 1995/08/04 15:50:44 john`
		122	`* Minor change`
		123	`*`
		124	`* Revision 1.13 1995/07/27 10:09:55 john`
		125	`* Changes to needs`
		126	`*`
		127	`* Revision 1.12 1995/07/04 09:08:09 john`
		128	`* Temporary change to ident_tag`
		129	`*`
		130	`* Revision 1.11 1995/06/30 08:00:12 john`
		131	`* Removed next_frame_tag made change to ident_tag`
		132	`*`
		133	`* Revision 1.10 1995/06/28 10:26:42 john`
		134	`* Fixed needs for cont_tag`
		135	`*`
		136	`* Revision 1.9 1995/06/21 14:25:39 john`
		137	`* Reformatting`
		138	`*`
		139	`* Revision 1.8 1995/06/15 09:43:57 john`
		140	`* Fixed code for stack error handling`
		141	`*`
		142	`* Revision 1.7 1995/06/13 14:01:45 john`
		143	`* A few cosmetic changes`
		144	`*`
		145	`* Revision 1.6 1995/05/23 13:26:09 john`
		146	`* Reformatting`
		147	`*`
		148	`* Revision 1.5 1995/05/16 10:55:24 john`
		149	`* Changes for spec 3.1`
		150	`*`
		151	`* Revision 1.4 1995/04/10 14:14:05 john`
		152	`* Fix to likeplus`
		153	`*`
		154	`* Revision 1.3 1995/04/07 11:05:49 john`
		155	`* Fix to scan_cond, and removed subvar_use`
		156	`*`
		157	`* Revision 1.2 1995/03/29 14:05:28 john`
		158	`* Changes to keep tcheck happy`
		159	`*`
		160	`* Revision 1.1.1.1 1995/03/23 10:39:17 john`
		161	`* Entered into CVS`
		162	`*`
		163	`* Revision 1.22 1995/03/23 10:13:55 john`
		164	`* Several changes for AVS test suite`
		165	`*`
		166	`* Revision 1.21 1995/02/13 09:50:32 john`
		167	`* Changed handling of cond_tag`
		168	`*`
		169	`* Revision 1.20 1995/01/26 13:49:17 john`
		170	`* Removed unused code`
		171	`*`
		172	`* Revision 1.19 1995/01/10 09:44:53 john`
		173	`* Modified register requirements.`
		174	`*`
		175	`*/`
		176
		177	`/*`
		178	`scan.c`
7	7u83	179	`Defines the scan through a program which reorganises it so`
		180	`that all arguments of operations are suitable for later`
		181	`code-production. The procedure scan evaluates the register`
		182	`requirements of an exp. The exps are produced from the decoding`
		183	`process and the various exp -> exp transformations in the proc`
2	7u83	184	`independent (common to other translators)`
		185	`*/`
7	7u83	186
2	7u83	187	`#include "config.h"`
		188	`#include "common_types.h"`
		189	`#include "exptypes.h"`
		190	`#include "exp.h"`
		191	`#include "expmacs.h"`
		192	`#include "tags.h"`
		193	`#include "procrectypes.h"`
		194	`#include "bitsmacs.h"`
		195	`#include "maxminmacs.h"`
		196	`#include "regable.h"`
		197	`#include "tempdecs.h"`
		198	`#include "shapemacs.h"`
		199	`#include "special.h"`
		200	`#include "const.h"`
		201	`#include "new_tags.h"`
		202	`#include "flpt.h"`
		203	`#include "install_fns.h"`
		204	`#include "externs.h"`
		205	`#include "extratags.h"`
		206	`#include "frames.h"`
		207	`#include "regexps.h"`
		208	`#include "reg_defs.h"`
		209	`#include "bool.h"`
		210	`#include "oddtest.h"`
		211	`#include "check.h"`
		212	`#include "coder.h"`
		213	`#include "szs_als.h"`
		214	`#include "scan.h"`
		215
		216	`int maxfix, maxfloat; /* the maximum number of t-regs */`
		217	`static int stparam, fixparam, floatparam;`
		218	`/* used by scan to set initial parameter positions */`
		219	`static int numparams=0;`
		220
7	7u83	221	`extern alignment long_to_al(int);`
		222
2	7u83	223	`extern long notbranch[6];`
		224	`extern bool do_tlrecursion;`
		225
		226	`static bool rscope_level = 0;`
		227	`static bool nonevis = 1;`
		228	`static int callerfortr;`
		229
7	7u83	230	`needs scan(exp ,exp *);`
2	7u83	231
		232	`/*`
		233	`identifies integer varieties which require more work to manipulate`
		234	`(because of a lack of appropriate instructions)`
		235	`*/`
7	7u83	236	`#define is_awkward_variety(vname)((vname == scharhd \|\| vname == ucharhd \`
2	7u83	237	`\|\| vname == swordhd \|\| vname == uwordhd))`
		238
		239
		240
7	7u83	241	`/*`
		242	`declaration of scan.`
2	7u83	243	`needs is defined in procrectypes.h.`
		244	`This is a structure which has two integers giving`
7	7u83	245	`the number of fixed and floating point registers required`
		246	`to contain live values in the expression parameters. A`
		247	`further field prop is used for various flags about certain`
		248	`forms of exp (mainly idents and procs). The maxargs field`
		249	`gives the maximum size in bits for the parameters of all the`
		250	`procs called in the exp. The needs of a proc body are preserved`
2	7u83	251	`in the needs field of the procrec (see procrectypes.h).`
		252	`*/`
		253
		254
7	7u83	255	`#if DO_NEW_DIVISION`
		256	`#define is_machine_divide(e)(name(bro(son(e)))!= val_tag)`
2	7u83	257	`#else`
7	7u83	258	`#define is_machine_divide(e)1`
2	7u83	259	`#endif`
		260
		261
		262	`/*`
		263	`cca`
7	7u83	264
		265	`This procedure effectively inserts a new declaration into an`
		266	`exp. This is used to stop a procedure requiring more than the`
2	7u83	267	`available number of registers.`
		268	`*/`
		269	`void cca`
7	7u83	270	`(exp *to, exp x)`
2	7u83	271	`{`
		272
7	7u83	273	`if (name((**to)) ==diagnose_tag) {`
		274	`to = & (son((*to)));`
2	7u83	275	`}`
		276	`if (x == (*to)) {`
7	7u83	277	`exp def = *(x);`
2	7u83	278	`/* replace by Let tg = def In tg Ni */`
7	7u83	279	`exp id = getexp(sh(def), bro(def), last(def), def, nilexp,`
2	7u83	280	`0, 1, ident_tag);`
7	7u83	281	`exp tg = getexp(sh(def), id, 1, id, nilexp,`
2	7u83	282	`0, 0, name_tag);`
		283	`pt (id) = tg; /* use of tag */`
		284	`bro (def) = tg; /* bro(def) is body of Let = tg */`
7	7u83	285	`clearlast(def);`
2	7u83	286	`* (x) = id; /* replace pointer to x by Let */`
		287	`return;`
		288	`}`
		289	`else { /* replace by Let tg = def In ato/def = tg`
		290	`Ni */`
7	7u83	291	`exp def = *(x);`
		292	`exp ato = (to);`
		293	`exp id = getexp(sh(ato), bro(ato), last(ato), def, nilexp,`
2	7u83	294	`0, 1, ident_tag);`
7	7u83	295	`exp tg = getexp(sh(def), bro(def), last(def), id, nilexp,`
2	7u83	296	`0, 0, name_tag);`
		297	`pt (id) = tg; /* use of tg */`
		298	`bro (def) = ato; /* ato is body of Let */`
7	7u83	299	`clearlast(def);`
2	7u83	300	`bro (ato) = id; /* its father is Let */`
7	7u83	301	`setlast(ato);`
2	7u83	302	`* (to) = id; / replace pointer to 'to' by Let */`
		303	`* (x) = tg; /* replace use of x by tg */`
		304	`to = & bro(def); / later replacement to same 'to' will be`
		305	`at body of Let */`
		306	`return;`
		307	`}`
		308	`}`
		309
		310	`needs onefix = {`
		311	`1, 0, 0, 0`
		312	`}; /* needs one fix pt reg */`
		313	`needs twofix = {`
		314	`2, 0, 0, 0`
		315	`}; /* needs 2 fix pt regs */`
		316
		317	`needs threefix = {`
		318	`3,0,0,0`
		319	`};`
		320
		321
		322	`needs fourfix = {`
		323	`4,0,0,0`
		324	`};`
		325
		326	`needs fivefix = {`
		327	`5,0,0,0`
		328	`};`
		329
		330
		331	`needs onefloat = {`
		332	`0, 1, 0, 0`
		333	`}; /* needs 1 flt pt regs */`
		334	`needs zeroneeds = {`
		335	`0, 0, 0, 0`
		336	`}; /* has no needs */`
		337
		338
7	7u83	339
2	7u83	340	`/*`
7	7u83	341	`Calculate the number of registers required to move a data item of`
2	7u83	342	`shape s to/from memory. Worst case values.`
		343	`*/`
		344	`needs shapeneeds`
7	7u83	345	`(shape s)`
2	7u83	346	`{`
7	7u83	347	`if (is_floating(name(s))) {`
2	7u83	348	`return onefloat;`
		349	`}`
		350	`else{`
		351	`ash as;`
		352	`as = ashof(s);`
		353	`if((as.ashalign==8) /&& (name(s)==ptrhd)/){`
		354	`return fourfix;`
		355	`}`
7	7u83	356	`if ((as.ashalign==16)) {`
2	7u83	357	`return fivefix; /* If not aligned on 4 byte boundary */`
		358	`}`
7	7u83	359	`if (valregable(s)) {`
2	7u83	360	`return onefix;`
		361	`}`
		362	`else{`
		363	`return twofix;`
		364	`}`
		365	`}`
		366	`}`
		367
		368	`static void make_bitfield_offset`
7	7u83	369	`(exp e, exp pe, int spe, shape sha)`
2	7u83	370	`{`
		371	`exp omul;`
		372	`exp val8;`
7	7u83	373	`if (name(e) == val_tag) {`
		374	`no(e)*= 8;`
2	7u83	375	`return;`
		376	`}`
7	7u83	377	`omul = getexp(sha,bro(e), (int)(last(e)),e,nilexp,0,0,offset_mult_tag);`
2	7u83	378	`val8 = getexp(slongsh,omul,1,nilexp,nilexp,0,8,val_tag);`
		379	`clearlast(e);`
		380	`setbro(e, val8);`
7	7u83	381	`if (spe) {`
2	7u83	382	`son(pe) = omul;`
		383	`}`
		384	`else{`
		385	`bro(pe) = omul;`
		386	`}`
		387	`return;`
		388	`}`
		389
		390	`bool complex`
7	7u83	391	`(exp e)`
2	7u83	392	`{`
		393	`/* these are basically the expressions`
		394	`which cannot be accessed by a simple`
		395	`load or store instruction */`
7	7u83	396	`if (name(e) == name_tag \|\|`
		397	`(name(e) == cont_tag && name(son(e)) == name_tag &&`
		398	`isvar(son(son(e))))`
		399	`\|\| name(e) == val_tag \|\| name(e) == real_tag \|\| name(e) ==null_tag) {`
2	7u83	400	`return 0;`
		401	`}`
		402	`else {`
		403	`return 1;`
		404	`}`
		405	`}`
		406
		407	`int scan_cond`
7	7u83	408	`(exp *e, exp outer_id)`
2	7u83	409	`{`
		410	`exp ste = *e;`
7	7u83	411	`exp first = son(ste);`
		412	`exp labst = bro(first);`
		413	`exp second = bro(son(labst));`
		414
		415	`Assert(name(ste) ==cond_tag);`
		416
		417	`if (name(second) ==top_tag && name(sh(first)) ==bothd && no(son(labst)) ==1`
		418	`&& name(first) ==seq_tag && name(bro(son(first))) == goto_tag) {`
2	7u83	419	`/* cond is { ... test(L); ? ; goto X \| L:make_top}`
		420	`if ? empty can replace by seq { ... not-test(X); make_top }`
		421	`*/`
		422	`exp l = son(son(first));`
7	7u83	423	`while (!last(l)) { l = bro(l); }`
		424	`while (name(l) ==seq_tag) { l = bro(son(l)); }`
		425	`if (name(l) ==test_tag && pt(l) ==labst) {`
		426	`settest_number(l, notbranch[test_number(l) -1]);`
2	7u83	427	`pt(l) = pt(bro(son(first)));`
		428	`bro(son(first)) = second;`
		429	`bro(second) = first; setlast(second);`
7	7u83	430	`bro(first) = bro(ste);`
		431	`if (last(ste)) { setlast(first);} else { clearlast(first); }`
2	7u83	432	`*e = first;`
		433	`return 1;`
		434	`}`
		435	`else return 0;`
		436	`}`
		437
		438
7	7u83	439	`if (name(first) == seq_tag && name(second) == cond_tag`
		440	`&& no(son(labst)) == 1`
		441	`&& name(son(son(first))) == test_tag`
		442	`&& pt(son(son(first))) == labst`
		443	`&& name(son(second)) == seq_tag`
		444	`&& name(son(son(son(second)))) == test_tag) {`
		445	`/* cond is ( seq (test to L;....\| L:cond(seq(test;...),...) )`
2	7u83	446	`..... */`
7	7u83	447	`exp test1 = son(son(first));`
		448	`exp test2 = son(son(son(second)));`
2	7u83	449	`exp op11 = son(test1);`
		450	`exp op21 = bro(op11);`
		451	`exp op12 = son(test2);`
		452	`exp op22 = bro(op12);`
7	7u83	453	`bool c1 = complex(op11);`
		454	`bool c2 = complex(op21);`
2	7u83	455
7	7u83	456	`if (c1 && eq_exp(op11, op12)) {`
2	7u83	457	`/* ....if first operands of tests are`
		458	`same, identify them */`
7	7u83	459	`exp newid = getexp(sh(ste), bro(ste), last(ste), op11, nilexp,`
2	7u83	460	`0, 2, ident_tag);`
7	7u83	461	`exp tg1 = getexp(sh(op11), op21, 0, newid, nilexp, 0, 0, name_tag);`
		462	`exp tg2 = getexp(sh(op12), op22, 0, newid, nilexp, 0, 0, name_tag);`
		463
		464	`pt(newid) = tg1;`
2	7u83	465	`pt (tg1) = tg2; /* uses of newid */`
		466	`bro (op11) = ste; clearlast (op11);/* body of newid */`
		467	`/* forget son test2 = son test1 */`
7	7u83	468	`bro(ste) = newid;`
2	7u83	469	`setlast (ste); /* father body = newid */`
7	7u83	470	`son(test1) = tg1;`
2	7u83	471	`son (test2) = tg2; /* relace 1st operands of test */`
7	7u83	472	`if (!complex(op21)) {`
		473	`/* if the second operand of 1st test is`
		474	`simple, then identification could go`
2	7u83	475	`in a t-teg (!!!NB overloading of inlined flag!!!).... */`
7	7u83	476	`setinlined(newid);`
2	7u83	477	`}`
		478	`kill_exp(op12, op12);`
7	7u83	479	`*(e) = newid;`
		480	`if (scan_cond(&bro(son(labst)), newid) == 2 && complex(op22)) {`
		481	`/* ... however a further use of identification means that`
2	7u83	482	`the second operand of the second test must also be simple */`
		483	`clearinlined(newid);`
		484	`}`
		485	`return 1;`
		486	`}`
7	7u83	487	`else if (c2 && eq_exp(op21, op22)) {`
2	7u83	488	`/* ....if second operands of tests are`
		489	`same, identify them */`
		490
7	7u83	491	`exp newid = getexp(sh(ste), bro(ste), last(ste), op21,`
2	7u83	492	`nilexp, 0, 2, ident_tag);`
7	7u83	493	`exp tg1 = getexp(sh(op21), test1, 1,`
2	7u83	494	`newid, nilexp, 0, 0, name_tag);`
7	7u83	495	`exp tg2 = getexp(sh(op22), test2, 1, newid, nilexp,`
2	7u83	496	`0, 0, name_tag);`
		497
7	7u83	498	`pt(newid) = tg1;`
2	7u83	499	`pt (tg1) = tg2; /* uses of newid */`
7	7u83	500	`bro(op21) = ste; clearlast(op21);`
2	7u83	501	`/* body of newid */`
		502	`/* forget bro son test2 = bro son test1 */`
7	7u83	503	`bro(ste) = newid;`
2	7u83	504	`setlast (ste); /* father body = newid */`
7	7u83	505	`bro(op11) = tg1;`
		506	`bro(op12) = tg2;`
		507	`if (!complex(op11)) { setinlined(newid); }`
2	7u83	508	`kill_exp(op22, op22);`
		509	`/* relace 2nd operands of test */`
7	7u83	510	`*(e) = newid;`
		511	`if (scan_cond(&bro(son(labst)), newid) == 2 && complex(op12)) {`
		512	`clearinlined(newid);`
2	7u83	513	`}`
		514	`return 1;`
		515	`}`
7	7u83	516	`else if (name(op12)!= name_tag`
		517	`&& name(op11) == name_tag`
		518	`&& son(op11) == outer_id`
		519	`&& eq_exp(son(outer_id), op12)`
		520	`) {`
		521	`/* 1st param of test1 is already identified with`
2	7u83	522	`1st param of test2 */`
7	7u83	523	`exp tg = getexp(sh(op12), op22, 0, outer_id,`
		524	`pt(outer_id), 0, 0, name_tag);`
		525	`pt(outer_id) = tg;`
		526	`no(outer_id) += 1;`
		527	`if (complex(op21)) { clearinlined(outer_id); }`
2	7u83	528	`/* update usage of ident */`
7	7u83	529	`son(test2) = tg;`
2	7u83	530	`kill_exp(op12, op12);`
7	7u83	531	`if (scan_cond(&bro(son(labst)), outer_id) == 2 && complex(op22)) {`
2	7u83	532	`clearinlined(outer_id);`
		533	`}`
		534	`return 2;`
		535	`}`
7	7u83	536	`}`
2	7u83	537	`return 0;`
		538	`}`
		539
7	7u83	540	`/*`
		541	`does the scan on commutative and associative operations and`
		542	`may perform various transformations allowed by these properties`
2	7u83	543	`*/`
		544	`needs likeplus`
7	7u83	545	`(exp e, exp *at)`
2	7u83	546	`{`
		547	`needs a1;`
		548	`needs a2;`
		549	`prop pc;`
		550	`exp * br = &son(*e);`
7	7u83	551	`exp dad = *(e);`
2	7u83	552	`exp prev;`
		553	`bool commuted = 0;`
		554
		555	`#if 0`
7	7u83	556	`if (optop(*e)) {`
		557	`Assert(name(*br)!= val_tag);`
2	7u83	558	`}`
		559	`#endif`
7	7u83	560	`a1 = scan(br, at);`
2	7u83	561	`/* scan the first operand - won't be a val_tag */`
		562	`do {`
		563	`exp * prevbr;`
		564	`prevbr = br;`
7	7u83	565	`prev = *(br);`
2	7u83	566	`br = &bro(prev);`
7	7u83	567	`a2 = scan(br, at);`
		568	`/* scan the next operand ... */`
		569	`if (name(*(br))!= val_tag) {`
		570	`a1.floatneeds = max(a1.floatneeds, a2.floatneeds);`
2	7u83	571	`pc = a2.propsneeds & hasproccall;`
		572	`if (a2.fixneeds < maxfix && pc == 0) {`
		573	`/* ..its evaluation will not disturb the accumulated result */`
7	7u83	574	`a1.fixneeds = max(a1.fixneeds, a2.fixneeds + 1);`
2	7u83	575	`a1.propsneeds = a1.propsneeds \| a2.propsneeds;`
		576	`}`
		577	`else if (a1.fixneeds < maxfix &&`
7	7u83	578	`(a1.propsneeds & hasproccall) == 0 && !commuted) {`
2	7u83	579	`/* ..its evaluation will call a proc, so put it first */`
7	7u83	580	`exp op1 = son(dad);`
		581	`exp cop = *(br);`
		582	`bool lcop = last(cop);`
		583	`bro(prev) = bro(cop);`
2	7u83	584	`if (lcop)`
7	7u83	585	`setlast(prev);`
		586	`bro(cop) = op1;`
		587	`clearlast(cop);`
		588	`son(dad) = cop;`
		589	`br = (prev==op1)? &bro(cop):prevbr;`
2	7u83	590	`commuted = 1;`
7	7u83	591	`a1.fixneeds = max(a2.fixneeds, a1.fixneeds + 1);`
2	7u83	592	`a1.propsneeds \|= a2.propsneeds;`
7	7u83	593	`a1.maxargs = max(a1.maxargs, a2.maxargs);`
2	7u83	594	`}`
		595	`else { /* ... its evaluation would disturb`
		596	`accumulated result, so replace it by a`
		597	`newly declared tag */`
7	7u83	598	`cca(at, br);`
		599	`a1.fixneeds = max(a1.fixneeds, 2);`
2	7u83	600	`a1.propsneeds = a1.propsneeds \| morefix \| (pc << 1);`
7	7u83	601	`a1.maxargs = max(a1.maxargs, a2.maxargs);`
2	7u83	602	`}`
7	7u83	603	`}`
		604	`} while (!last(*(br)));`
2	7u83	605	`return a1;`
		606	`}`
		607
		608
		609	`needs likediv`
7	7u83	610	`(exp e, exp *at)`
2	7u83	611	`{`
7	7u83	612	`/* scan non-commutative fix pt operation`
2	7u83	613	`*/`
		614	`needs l;`
		615	`needs r;`
		616	`prop pc;`
		617	`exp * arg = &son(*e);`
7	7u83	618	`l = scan(arg, at);`
2	7u83	619	`/* scan 1st operand */`
		620	`arg = &bro(*arg);`
7	7u83	621	`r = scan(arg, at);`
2	7u83	622	`/* scan second operand ... */`
7	7u83	623	`l.floatneeds = max(l.floatneeds, r.floatneeds);`
2	7u83	624	`pc = r.propsneeds & hasproccall;`
		625	`if (r.fixneeds < maxfix && pc == 0) {/* ...it fits into registers */`
7	7u83	626	`l.fixneeds = max(l.fixneeds, r.fixneeds + 1);`
2	7u83	627	`l.propsneeds = l.propsneeds \| r.propsneeds;`
		628	`}`
		629	`else { /* ...it requires new declaration of`
		630	`second operand */`
7	7u83	631	`cca(at, arg);`
		632	`l.fixneeds = max(l.fixneeds, 1);`
2	7u83	633	`l.propsneeds = l.propsneeds \| morefix \| (pc << 1);`
7	7u83	634	`l.maxargs = max(l.maxargs, r.maxargs);`
2	7u83	635	`}`
		636	`return l;`
		637	`}`
		638
		639	`needs fpop`
7	7u83	640	`(exp e, exp *at)`
2	7u83	641	`{`
		642	`/* scans diadic floating point operation */`
		643	`needs l;`
		644	`needs r;`
		645	`exp op = *(e);`
		646	`prop pcr, pcl;`
		647	`exp * arg = &son(op);`
		648	`bool withert = !(optop(*e));`
		649
7	7u83	650	`l = scan(arg, at);`
2	7u83	651	`arg = &bro(*arg);`
7	7u83	652	`r = scan(arg, at);`
		653	`l.fixneeds = max(l.fixneeds, r.fixneeds);`
2	7u83	654	`pcr = r.propsneeds & hasproccall;`
		655	`pcl = l.propsneeds & hasproccall;`
		656
		657	`if (r.floatneeds <= l.floatneeds && r.floatneeds < maxfloat && pcr==0) {`
7	7u83	658	`l.floatneeds = max(2, max(l.floatneeds, r.floatneeds + 1));`
2	7u83	659	`l.propsneeds = l.propsneeds \| r.propsneeds;`
		660	`ClearRev(op);`
		661	`}`
7	7u83	662	`else if (pcl == 0 && l.floatneeds<=r.floatneeds && l.floatneeds<maxfloat) {`
		663	`l.floatneeds = max(2, max(r.floatneeds, l.floatneeds + 1));`
2	7u83	664	`l.propsneeds = l.propsneeds \| r.propsneeds;`
		665	`SetRev(op);`
7	7u83	666	`}`
2	7u83	667	`else if (r.floatneeds < maxfloat && pcr == 0) {`
7	7u83	668	`l.floatneeds = max(2, max(l.floatneeds, r.floatneeds + 1));`
2	7u83	669	`l.propsneeds = l.propsneeds \| r.propsneeds;`
		670	`ClearRev(op);`
		671	`}`
		672	`else {`
7	7u83	673	`cca(at, arg);`
2	7u83	674	`ClearRev(op);`
7	7u83	675	`l.floatneeds = max(l.floatneeds, 2);`
2	7u83	676	`l.propsneeds = l.propsneeds \| morefloat \| (pcr << 1);`
7	7u83	677	`l.maxargs = max(l.maxargs, r.maxargs);`
2	7u83	678	`}`
7	7u83	679	`if (withert && l.fixneeds < 2)l.fixneeds = 2;`
2	7u83	680	`return l;`
		681	`}`
		682
		683	`/*`
		684	`maxneeds`
7	7u83	685	`Calculates a needs value. Each element of which is the`
2	7u83	686	`maximum of the corresponding elements in the two parameter needs`
		687	`*/`
		688	`needs maxneeds`
7	7u83	689	`(needs a, needs b)`
2	7u83	690	`{`
		691	`needs an;`
7	7u83	692	`an.fixneeds = max(a.fixneeds, b.fixneeds);`
		693	`an.floatneeds = max(a.floatneeds, b.floatneeds);`
		694	`an.maxargs = max(a.maxargs, b.maxargs);`
2	7u83	695	`an.numparams=max(a.numparams,b.numparams);`
		696	`an.propsneeds = a.propsneeds \| b.propsneeds;`
		697	`return an;`
		698	`}`
		699
7	7u83	700	`/*`
		701	`calculates the needs of a tuple of expressions; any new`
2	7u83	702	`declarations required by a component expression will`
7	7u83	703	`replace the component expression`
2	7u83	704	`*/`
		705	`needs maxtup`
7	7u83	706	`(exp e, exp **at)`
2	7u83	707	`{`
		708	`exp * stat = &son(e);`
		709	`needs an;`
7	7u83	710
2	7u83	711	`an = zeroneeds;`
7	7u83	712	`if (son(e) == nilexp) return zeroneeds;`
		713	`while (an = maxneeds(an, scan(stat, at)), !last(*stat)) {`
2	7u83	714	`stat = &bro(*stat);`
		715	`}`
		716	`return an;`
		717	`}`
		718
7	7u83	719	`/*`
		720	`finds if usedname is only used in cont operation or as result`
		721	`of ident i.e. value of name is unchanged over its scope`
2	7u83	722	`*/`
		723	`bool unchanged`
7	7u83	724	`(exp usedname, exp ident)`
2	7u83	725	`{`
7	7u83	726	`exp uses = pt(usedname);`
2	7u83	727	`while (uses != nilexp) {`
7	7u83	728	`if (intnl_to(ident, uses)) {`
		729	`if (!last(uses) \|\| name(bro(uses))!= cont_tag) {`
2	7u83	730	`exp z = uses;`
		731	`while (z != ident) {`
7	7u83	732	`if (!last(z) \|\|`
		733	`(name(bro(z))!= seq_tag && name(bro(z))!= ident_tag)) {`
2	7u83	734	`return 0;`
		735	`}`
7	7u83	736	`z = bro(z);`
2	7u83	737	`}`
		738	`}`
		739	`}`
7	7u83	740	`uses = pt(uses);`
2	7u83	741	`}`
		742	`return 1;`
		743	`}`
		744
		745
		746	`/* check if e is (let a = 0 in cond(inttest(L)=result; a=1 \| L:top);`
		747	`a ni ) This will be compiled later using set instructions instead`
7	7u83	748	`of branches`
2	7u83	749	`*/`
		750	`exp absbool`
7	7u83	751	`(exp id)`
2	7u83	752	`{`
7	7u83	753	`if (isvar(id) && name(son(id)) == val_tag && no(son(id)) == 0`
2	7u83	754	`&& no (id) == 2 /* name initially 0 only used twice */ ) {`
7	7u83	755	`exp bdy = bro(son(id));`
		756	`if (name(bdy) == seq_tag && name(bro(son(bdy))) == cont_tag &&`
		757	`name(son(bro(son(bdy)))) == name_tag &&`
		758	`son(son(bro(son(bdy)))) == id`
2	7u83	759	`/* one use is result of sequence body */ ) {`
7	7u83	760	`exp c = son(son(bdy));`
2	7u83	761	`if (last (c) && name (c) == cond_tag /* seq is cond=c; id */ ) {`
7	7u83	762	`exp first = son(c);`
		763	`exp second = bro(son(c));`
2	7u83	764	`if (no (son (second)) == 1 /* only one jump to else */ &&`
7	7u83	765	`name(bro(son(second))) == top_tag`
2	7u83	766	`&& name (first) == seq_tag /* cond is (seq= first \| L: top) */ ) {`
7	7u83	767	`exp s = son(son(first));`
		768	`exp r = bro(son(first));`
		769	`if (name(r) == ass_tag && name(son(r)) == name_tag &&`
		770	`son(son(r)) == id && name(bro(son(r))) == val_tag &&`
2	7u83	771	`no (bro (son (r))) == 1 /* last of seq is id = 1 */ &&`
7	7u83	772	`last(s) && name(s) == test_tag && pt(s) == second`
		773	`&& !is_floating(name(sh(son(s))))`
2	7u83	774	`/* *t of seq is int test jumping to`
		775	`second */`
7	7u83	776	`) {`
2	7u83	777	`return s;`
		778	`}`
		779	`}`
		780	`}`
		781	`}`
		782	`}`
		783	`return 0;`
		784	`}`
		785
7	7u83	786
2	7u83	787	`exp * ptr_position`
7	7u83	788	`(exp e)`
2	7u83	789	`{`
		790	`exp * a;`
		791	`exp dad = father(e);`
7	7u83	792	`if (son(dad) ==e) {`
2	7u83	793	`a = &son(dad);`
		794	`}`
		795	`else {`
		796	`exp sib = son(dad);`
		797	`while (bro(sib)!=e) { sib = bro(sib); }`
		798	`a = &bro(sib);`
		799	`}`
		800	`return a;`
		801	`}`
		802
		803	`bool chase`
7	7u83	804	`(exp sel, exp *e)`
2	7u83	805	`{`
		806	`/* distribute selection throughout compound expressions */`
		807	`bool b = 0;`
		808	`exp * one;`
7	7u83	809	`switch (name(*e)) {`
		810	`case ident_tag:`
		811	`case seq_tag:`
		812	`case rep_tag:`
		813	`case labst_tag: {`
2	7u83	814	`b = chase(sel, &bro(son(*e)));`
		815	`break;`
		816	`}`
7	7u83	817	`case solve_tag:`
		818	`case cond_tag: {`
2	7u83	819	`one = &son(*e);`
7	7u83	820	`for (;;) {`
2	7u83	821	`b \|= chase(sel, one);`
7	7u83	822	`if (last(*one))break;`
2	7u83	823	`one = &bro(*one);`
		824	`}`
		825	`break;`
		826	`}`
7	7u83	827	`case field_tag: {`
2	7u83	828	`if (chase(e, &son(e))) {`
		829	`/* inner field has been distributed */`
		830	`exp stare = *e;`
		831	`exp ss = son(stare);`
7	7u83	832	`if (!last(stare))clearlast(ss);`
		833	`bro(ss) = bro(stare);`
		834	`sh(ss) = sh(stare);`
2	7u83	835	`*e = ss;`
		836	`return chase(sel, e);`
		837	`} /* ... continue to default */`
		838	`}`
		839	`FALL_THROUGH;`
		840	`default: {`
7	7u83	841	`if ((son(sel)!= e) && (name(sh(e))!=bothd)) {`
2	7u83	842	`/* only change if not outer */`
		843	`exp stare = *e;`
7	7u83	844	`exp newsel = getexp(sh(sel), bro(stare), last(stare), stare,`
		845	`nilexp,props(sel), no(sel), name(sel));`
		846	`*e = newsel;`
		847	`bro(stare) =newsel;setlast(stare);`
2	7u83	848	`b = 1;`
		849	`}`
		850	`}`
		851	`}`
7	7u83	852	`if (b)sh(*e) = sh(sel);`
2	7u83	853	`return b;`
7	7u83	854	`}`
2	7u83	855
		856
		857	`/* check for C style varargs */`
		858	`bool vascan`
7	7u83	859	`(exp *e)`
2	7u83	860	`{`
		861	`bool result = FALSE;`
		862	`exp tr;`
		863	`int s2;`
7	7u83	864	`for (tr=son(*e);(name(tr) ==ident_tag) && (isparam(tr)) && (!result);`
		865	`tr = bro(son(tr))) {`
2	7u83	866	`s2 = shape_size(sh(son(tr)));`
7	7u83	867	`result = (name(sh(son(tr))) ==cpdhd) &&last_param(tr) && (s2==0);`
2	7u83	868	`}`
		869	`return result;`
7	7u83	870	`}`
2	7u83	871
7	7u83	872
2	7u83	873	`bool gen_call;`
		874	`bool in_vcallers_proc;`
		875
		876
		877	`/*`
		878	`scan`
		879
		880	`This procedure works out register requirements of an exp. At each`
		881	`call the fix field of the needs is the number of fixpnt registers`
7	7u83	882	`required to contain live values to evaluate this expression.`
		883	`This never exceeds maxfix because if it would have, a new`
		884	`declaration is introduced in the exp tree (similarly for`
2	7u83	885	`floating regs and maxfloat). In these cases the prop field will`
		886	`contain the bits morefix (or morefloat).`
		887
7	7u83	888	`As well as working out the register requirements scan performs`
2	7u83	889	`some transformations on the procedure. It also determines whether`
		890	`or not the procedure uses varargs, if it contains a division by a`
		891	`non-constant, and if it may need to move values between float and`
		892	`fixed point registers.`
		893
		894	`If the procedure does contain a division by a non constant then`
7	7u83	895	`those registers which are corrupted by the division instruction`
2	7u83	896	`are not made available to the register allocator for the duration`
		897	`of that procedure (see settempregs()). A better, though more`
		898	`complicated, solution would be to disallow the use of these`
		899	`registers in evaluating the LHS of operations in which the RHS`
		900	`contains a division.`
		901	`*/`
		902	`needs scan`
7	7u83	903	`(exp e, exp *at)`
2	7u83	904	`{`
		905	`/* e is the expression to be scanned, at`
		906	`is the place to put any new decs . NB order of recursive`
		907	`calls with same at is critical */`
		908	`static int has_old_varargs;`
		909	`static int has_div;`
		910	`static int has_float;`
7	7u83	911	`exp ste = *(e);`
		912	`int nstare = name(ste);`
		913
2	7u83	914	`switch (nstare) {`
7	7u83	915	`case 0: {`
2	7u83	916	`return zeroneeds;`
		917	`}`
7	7u83	918
		919	`case compound_tag:`
		920	`case nof_tag:`
		921	`case concatnof_tag:`
		922	`case ncopies_tag:{`
2	7u83	923	`needs nl;`
		924	`bool cantdo;`
		925	`exp dad;`
7	7u83	926	`if (name(ste) ==ncopies_tag && name(son(ste))!=name_tag`
		927	`&& name(son(ste))!= val_tag) {`
2	7u83	928	`nl = scan(&son(*e), at);`
		929	`cca(at, &son(*e));`
7	7u83	930	`}`
2	7u83	931	`else nl = maxtup(*(e), at);`
		932	`dad = father(ste);`
7	7u83	933	`if (name(dad) ==compound_tag \|\| name(dad) == nof_tag`
2	7u83	934	`\|\| name(dad) == concatnof_tag) {`
		935	`cantdo=0;`
		936	`}`
7	7u83	937	`else if (last(ste)) {`
		938	`if (name(bro(ste)) == ass_tag) {`
2	7u83	939	`exp a = son(bro(ste));`
7	7u83	940	`cantdo = (name(a)!= name_tag \|\| !isvar(son(a)));`
2	7u83	941	`}`
		942	`else cantdo = 1;`
		943	`}`
7	7u83	944	`else if (last(bro(ste))) { cantdo = (name(bro(bro(ste)))!= ident_tag);}`
2	7u83	945	`else cantdo = 1;`
7	7u83	946
		947	`if (cantdo) {`
2	7u83	948	`/can only deal with tuples in simple assignment or identity/`
		949	`int prps = (nl.propsneeds & hasproccall) << 1;`
		950	`cca(at, ptr_position(ste));`
		951	`nl = shapeneeds(sh(*(e)));`
		952	`nl.propsneeds \|= morefix;`
7	7u83	953	`nl.propsneeds \|= prps;`
2	7u83	954	`}`
7	7u83	955
		956	`if (nl.fixneeds <2)nl.fixneeds = 2;`
2	7u83	957	`return nl;`
		958	`}`
7	7u83	959
		960	`case cond_tag: {`
2	7u83	961	`exp t, f, v;`
7	7u83	962	`if (oddtest(ste, & t, &f, &v)) {`
2	7u83	963	`/* transform to f((absbool(t) <<1)-1) */`
		964	`exp bc = bro(ste);`
		965	`bool lc = last(ste);`
		966	`exp ab = getexp(sh(v),nilexp,0,t, nilexp, 0, 0, absbool_tag);`
		967	`exp shl = getexp(sh(v), nilexp, 0, ab, nilexp, 0, 0, shl_tag);`
		968	`exp v1 = getexp(sh(v), shl, 1, nilexp,nilexp, 0, 1, val_tag);`
		969	`exp p = getexp(sh(v), nilexp, 1, shl, nilexp, 0, 0, plus_tag);`
		970	`exp vm1 = getexp(sh(v), p, 1, nilexp,nilexp, 0, -1, val_tag);`
		971	`bro(ab) = v1;`
		972	`bro(shl) = vm1;`
		973	`bro(t) = ab; setlast(t);`
7	7u83	974	`if (no(v) ==-1) {settest_number(t, notbranch[test_number(t) -1]);}`
2	7u83	975	`if (f==v) {`
		976	`*e = p;`
		977	`}`
		978	`else {`
		979	`son(bro(v)) = p;`
		980	`bro(p) = bro(v);`
		981	`*e = f;`
		982	`}`
		983	`bro(e) = bc; if (lc) { setlast(e); } else {clearlast(*e); }`
		984	`return scan(e, at);`
		985	`}`
7	7u83	986	`/*`
2	7u83	987	`if (is_maxlike(ste, &t) ) {`
		988	`son(ste) = t;`
		989	`bro(t) = ste; setlast(t);`
		990	`setname(ste, maxlike_tag);`
		991	`return scan(&son(ste), at);`
		992	`}`
		993	`if (is_minlike(ste, &t) ) {`
		994	`son(ste) = t;`
		995	`bro(t) = ste; setlast(t);`
		996	`setname(ste, minlike_tag);`
		997	`return scan(&son(ste), at);`
		998	`}`
		999	`*/`
7	7u83	1000	`if (is_abslike(ste, &t)) {`
2	7u83	1001	`son(ste) = t;`
		1002	`bro(t) = ste; setlast(t);`
		1003	`setname(ste, abslike_tag);`
		1004	`return scan(&son(ste), at);`
		1005	`}`
7	7u83	1006	`if (is_fabs(ste, &t)) {`
2	7u83	1007	`son(ste) = son(t);`
		1008	`bro(son(t)) = ste; setlast(son(t));`
		1009	`setname(ste, fabs_tag);`
		1010	`return scan(&son(ste), at);`
		1011	`}`
		1012
7	7u83	1013	`if (scan_cond(e, nilexp)!=0) {`
2	7u83	1014	`return scan(e, at);`
		1015	`} /* else goto next case */`
		1016	`}`
		1017	`FALL_THROUGH;`
7	7u83	1018	`case labst_tag:`
		1019	`case rep_tag:`
		1020	`case solve_tag: {`
2	7u83	1021	`exp * stat;`
		1022	`exp * statat;`
		1023	`needs an;`
		1024	`stat = &son(*e);`
		1025	`statat = stat;`
		1026	`an = zeroneeds;`
7	7u83	1027	`while (an = maxneeds(an, scan(stat, &statat)),`
		1028
		1029	`!last(*(stat))) {`
2	7u83	1030	`stat = &bro(*stat);`
		1031	`statat = stat;`
		1032	`}`
7	7u83	1033	`if ((an.propsneeds & usesproccall)!= 0) {`
2	7u83	1034	`an.propsneeds \|= hasproccall;`
		1035	`}`
		1036	`return an;`
		1037	`}`
7	7u83	1038
2	7u83	1039	`/*`
		1040	`ident`
7	7u83	1041
2	7u83	1042	`shape of exp is body,`
		1043	`son is def, brother of son is body,`
7	7u83	1044	`ptr of ident exp is chain of uses`
2	7u83	1045	`*/`
7	7u83	1046	`case ident_tag: {`
2	7u83	1047	`needs bdy;`
		1048	`needs def;`
7	7u83	1049	`exp stare = *(e);`
2	7u83	1050	`exp * arg = &bro(son(stare)); /* ptr to body */`
7	7u83	1051	`exp t = pt(stare);`
2	7u83	1052	`exp s;`
		1053	`bool fxregble;`
		1054	`bool flregble;`
		1055	`bool old_nonevis = nonevis;`
		1056	`exp ab;`
		1057	`/* bdy.numparams=0;*/`
		1058	`#if 1`
7	7u83	1059	`if (!iscaonly(stare))setvis(stare);`
		1060	`if (name(son(stare)) == formal_callee_tag) {`
2	7u83	1061	`setvis(stare);`
		1062	`}`
7	7u83	1063	`#endif`
		1064
		1065	`if (isparam(stare) && name(son(stare))!= formal_callee_tag) {`
2	7u83	1066	`exp def = son(stare);`
		1067	`shape shdef = sh(def);`
		1068	`long n = rounder(stparam, shape_align(shdef));`
		1069	`long sizep = shape_size(shdef);`
7	7u83	1070	`numparams = min(numparams+rounder(sizep,REG_SIZE),6*REG_SIZE);`
2	7u83	1071	`/numparams=min(numparams+max(REG_SIZE,sizep),6REG_SIZE);*/`
		1072	`/Assert(name(def)==clear_tag); /`
7	7u83	1073	`if (is_floating(name(shdef))) {`
		1074	`if (sizep<=64 && stparam <= 320) {`
2	7u83	1075	`props(def) = floatparam;`
		1076	`maxfloat--;`
7	7u83	1077	`}`
2	7u83	1078	`}`
		1079	`else if (sizep<=64 && stparam<=320 ) { /change for 64 bit regs/`
		1080	`props(def) = fixparam;`
		1081	`maxfix--;`
		1082	`}`
7	7u83	1083	`else if (stparam<=320) {`
2	7u83	1084	`props(def) = fixparam;`
		1085	`}`
7	7u83	1086	`else props(def) =0;`
2	7u83	1087	`stparam = rounder(n+sizep, 64 ); /* calculate the offset */`
		1088	`fixparam = 16+(stparam>>6); /* >> 6, was >>5 */`
7	7u83	1089	`floatparam=16+ (stparam>>6);`
		1090	`if (((isvis(stare) && props(son(stare))!=0 && (name(sh(son(stare))) ==cpdhd)) \|\| in_vcallers_proc) && last_param(stare)) {`
2	7u83	1091	`numparams=12REG_SIZE; / must allow space for all`
7	7u83	1092	`parameter registers for`
2	7u83	1093	`varargs function */`
		1094	`}`
7	7u83	1095	`no(def) =n;`
2	7u83	1096	`/* if varargs then save all param regs to stack */`
7	7u83	1097
2	7u83	1098	`if (!is_floating(name(shdef)) && !valregable(shdef))`
		1099	`setvis(stare);`
7	7u83	1100	`/* now props(def) = pos parreg and no(def) = par stack address`
		1101	`*/`
2	7u83	1102	`}`
7	7u83	1103	`else if (isparam(stare) && name(son(stare)) == formal_callee_tag) {`
2	7u83	1104	`exp def = son(stare);`
		1105	`shape shdef = sh(def);`
		1106	`long sizep = shape_size(shdef);`
		1107	`long alp = shape_align(shdef);`
		1108	`long n = rounder(callee_size, alp);`
		1109	`no(def) = n;`
		1110	`callee_size = rounder(n+sizep, REG_SIZE);`
		1111	`}`
7	7u83	1112	`if (gen_call) {`
2	7u83	1113	`numparams = max(6*REG_SIZE,numparams);`
		1114	`}`
7	7u83	1115
2	7u83	1116	`nonevis &= !isvis(stare);`
7	7u83	1117	`bdy = scan(arg, &arg);`
2	7u83	1118	`/* scan the body-scope */`
		1119	`arg = &son(stare);`
7	7u83	1120	`def = scan(arg, &arg);`
2	7u83	1121	`bdy.numparams = numparams;`
		1122	`/* scan the initialisation of tag */`
7	7u83	1123
2	7u83	1124	`nonevis = old_nonevis;`
7	7u83	1125	`t = son(stare);`
		1126	`s = bro(t);`
		1127	`fxregble = fixregable(stare);`
		1128	`flregble = floatregable(stare);`
		1129
		1130	`if (isparam(stare)) {`
		1131	`if (name(son(stare))!=formal_callee_tag && !isvis(stare) &&`
		1132	`!isoutpar(stare) && (bdy.propsneeds & anyproccall) ==0 ) {`
		1133	`/* leave pars in par regs or put in t-regs`
2	7u83	1134	`!! WHAT ABOUT TEMP DECS !!`
		1135	`*/`
		1136	`int x = props(son(stare));`
		1137	`if (x != 0) {`
7	7u83	1138	`no(stare) = x;`
		1139	`if (flregble) {`
		1140	`props(stare) \|= infreg_bits;`
2	7u83	1141	`}`
		1142	`else { props(stare) \|= inreg_bits; }`
		1143	`}`
7	7u83	1144	`else if (fxregble && bdy.fixneeds < maxfix &&`
		1145	`(bdy.propsneeds & morefix) == 0) {`
		1146	`no(stare) = NO_REG;`
2	7u83	1147	`props(stare) \|= inreg_bits;`
		1148	`bdy.fixneeds+=1;`
		1149	`}`
7	7u83	1150	`else if (flregble &&`
		1151	`bdy.floatneeds < maxfloat &&`
		1152	`(bdy.propsneeds & morefloat) == 0) {`
2	7u83	1153	`no(stare) = NO_REG;`
		1154	`props(stare) \|= infreg_bits;`
		1155	`bdy.floatneeds +=1;`
		1156	`}`
		1157	`else no(stare) = 100;`
		1158	`}`
		1159	`else no(stare) = 100;`
7	7u83	1160
2	7u83	1161	`}`
7	7u83	1162	`else {`
		1163	`if ((ab = absbool(stare))!= nilexp) {`
2	7u83	1164	`/* form is (let a = 0 in cond(test(L)=ab;`
		1165	`a=1 \| L:top) ni replace declaration by`
		1166	`ABS */`
7	7u83	1167	`bro(ab) = stare;`
2	7u83	1168	`setlast (ab); /* father => e /`
7	7u83	1169	`son(stare) = ab;`
		1170	`pt(stare) = nilexp;`
		1171	`pt(ab) = nilexp;`
		1172	`setname(stare, absbool_tag);`
		1173	`return maxneeds(bdy, def);`
2	7u83	1174	`}`
7	7u83	1175
		1176	`if (!isvis(e) && !isparam(e) &&`
		1177	`(bdy.propsneeds & (anyproccall \| uses2_bit)) == 0`
2	7u83	1178	`&& (fxregble \|\| flregble) &&`
7	7u83	1179	`(name(t) == apply_tag \|\| name(t) == apply_general_tag \|\|`
		1180	`(name(s) == seq_tag && name(bro(son(s))) == res_tag &&`
		1181	`name(son(bro(son(s)))) == cont_tag && isvar(stare) &&`
		1182	`name(son(son(bro(son(s))))) == name_tag &&`
		1183	`son(son(son(bro(son(s))))) == stare`
2	7u83	1184	`) /* Let a := ..; return cont a */`
7	7u83	1185	`)`
2	7u83	1186	`) { /* put tag in result reg if definition is`
		1187	`call of proc, or body ends with return`
		1188	`tag, provided result is not used other`
		1189	`wise */`
7	7u83	1190	`props(stare) \|= (fxregble)? inreg_bits : infreg_bits;`
2	7u83	1191	`bdy.propsneeds \|= uses2_bit;`
7	7u83	1192	`no (stare) = 101; /* identification uses result reg in body`
2	7u83	1193	`*/`
		1194	`}`
7	7u83	1195	`else if (!isvar(e) && !isparam(e) &&`
		1196	`((name(t) == reff_tag && name(son(t)) == cont_tag &&`
		1197	`name(son(son(t))) == name_tag && isvar(son(son(son(t))))`
		1198	`&& !isvis(son(son(son(t)))) &&`
		1199	`!isglob(son(son(son(t))))`
		1200	`&& unchanged(son(son(son(t))), stare)`
2	7u83	1201	`/* reff cont variable-not assigned to in`
		1202	`scope */`
7	7u83	1203	`) \|\|`
		1204	`(name(t) == cont_tag && name(son(t)) == name_tag &&`
		1205	`isvar(son(son(t))) && !isvis(son(son(t))) &&`
		1206	`!isglob(son(son(t))) && unchanged(son(son(t)), stare)`
2	7u83	1207	`/* cont variable - not assigned to in`
		1208	`scope */`
		1209	`)`
7	7u83	1210	`)`
		1211	`) {`
		1212	`props(stare) \|= defer_bit;`
2	7u83	1213	`/* dont take space for this dec */`
		1214	`}`
7	7u83	1215	`else if (!isvar(stare) && !isvis(stare) &&`
2	7u83	1216	`((props (stare) & 0x10 /* forced in const */ ) == 0)`
7	7u83	1217	`&& (name(t) == name_tag \|\| name(t) == val_tag)) {`
		1218	`props(stare) \|= defer_bit;`
2	7u83	1219	`/* dont take space for this dec */`
		1220	`}`
		1221	`else if (fxregble && (/isinlined(stare)\|\|/`
7	7u83	1222	`(bdy.fixneeds < maxfix &&`
		1223	`(bdy.propsneeds & morefix) == 0 &&`
		1224	`((bdy.propsneeds & anyproccall) == 0 \|\|`
		1225	`tempdec(stare,((bdy.propsneeds&morefix) ==0 &&`
		1226	`bdy.fixneeds < maxfix-2)))))) {`
2	7u83	1227	`/* put this tag in some fixpt t-reg -`
		1228	`which will be decided in make_code */`
7	7u83	1229	`props(stare) \|= inreg_bits;`
2	7u83	1230	`no (stare) = NO_REG; /* aha! */`
		1231	`bdy.fixneeds += 1;`
		1232	`}`
7	7u83	1233	`else if (bdy.floatneeds < maxfloat &&`
		1234	`(bdy.propsneeds & morefloat) == 0 && flregble &&`
		1235	`((bdy.propsneeds & anyproccall) == 0`
		1236	`\|\| tempdec(stare,((bdy.propsneeds & morefloat) == 0 &&`
2	7u83	1237	`bdy.floatneeds < maxfloat-2/6/)))) {`
		1238	`/* put this tag in some float t-reg -`
		1239	`which will be decided in make_code */`
7	7u83	1240	`props(stare) \|= infreg_bits;`
		1241	`no(stare) = NO_REG;`
2	7u83	1242	`bdy.floatneeds += 1;`
		1243	`}`
		1244	`else {`
		1245	`#if 1`
7	7u83	1246	`if (fxregble && ((bdy.propsneeds & anyproccall) == 0) &&`
		1247	`(bdy.fixneeds < maxfix)) {`
2	7u83	1248	`SetPossParReg(stare); /* +1 to fixneeds ? */`
		1249	`bdy.fixneeds += 1;`
		1250	`}`
		1251	`#endif`
7	7u83	1252	`no(stare) = 100;`
2	7u83	1253	`/* allocate either on stack or saved reg */`
		1254	`}`
		1255	`}`
7	7u83	1256	`bdy = maxneeds(bdy, def);`
		1257	`if ((bdy.propsneeds & usesproccall)!= 0) {`
2	7u83	1258	`bdy.propsneeds \|= hasproccall;`
		1259	`}`
		1260	`return bdy;`
		1261	`}`
7	7u83	1262
2	7u83	1263	`/*`
		1264	`sequence`
7	7u83	1265
		1266	`shape of exp is shape of end of sequence, son is sequence`
2	7u83	1267	`holder, son of this is list of voided statements.`
		1268	`*/`
7	7u83	1269
		1270	`case seq_tag: {`
2	7u83	1271	`exp * arg = &bro(son(*e));`
		1272	`needs an;`
		1273	`exp * stat;`
7	7u83	1274
		1275	`an = scan(arg, &arg);`
		1276	`stat = &son(son(*e));`
		1277
2	7u83	1278	`arg = stat;`
		1279	`for (;;) {`
		1280	`needs stneeds;`
7	7u83	1281	`stneeds = scan(stat, &arg);`
2	7u83	1282	`/* initial statements voided */`
7	7u83	1283	`an = maxneeds(an, stneeds);`
		1284	`if (last(*(stat))) {`
		1285	`if ((an.propsneeds & usesproccall)!= 0) {`
2	7u83	1286	`an.propsneeds \|= hasproccall;`
		1287	`}`
		1288	`return an;`
		1289	`}`
		1290	`stat = &bro(*stat);`
		1291	`arg = stat;`
		1292	`}`
7	7u83	1293
2	7u83	1294	`}`
7	7u83	1295
2	7u83	1296	`/*`
		1297	`goto`
7	7u83	1298
2	7u83	1299	`shape is bottom`
		1300	`son is exp for value jumped with`
		1301	`ptr is labelled exp`
		1302	`*/`
7	7u83	1303	`case goto_tag: {`
2	7u83	1304	`return zeroneeds;`
		1305	`}`
7	7u83	1306
		1307	`case ass_tag:`
		1308	`case assvol_tag: {`
2	7u83	1309	`exp * lhs = &son(*e);`
		1310	`exp * rhs = &bro(*lhs);`
		1311	`needs nr;`
		1312	`ash a;`
7	7u83	1313
		1314	`nr = scan(rhs, at);`
2	7u83	1315	`/* scan source */`
7	7u83	1316
		1317	`a = ashof(sh(*(rhs)));`
2	7u83	1318	`if (nstare != ass_tag \|\| a.ashsize != a.ashalign \|\| a.ashalign == 1) {`
		1319	`/* complicated move */`
		1320	`nr.propsneeds \|= uses2_bit;`
		1321	`}`
7	7u83	1322	`if (name(*(lhs)) == name_tag &&`
		1323	`(isvar(son(*(lhs))) \|\|`
		1324	`((nr.propsneeds & (hasproccall \| morefix)) == 0`
2	7u83	1325	`&& nr.fixneeds < maxfix`
		1326	`)`
7	7u83	1327	`)`
2	7u83	1328	`) { /* simple destination */`
		1329	`return nr;`
		1330	`}`
		1331	`else {`
		1332	`needs nl;`
		1333	`prop prps = (nr.propsneeds & hasproccall) << 1;`
7	7u83	1334	`nl = scan(lhs, at);`
2	7u83	1335	`/* scan destination */`
		1336	`nr.fixneeds += 1;`
7	7u83	1337	`if (name((rhs)) == apply_tag && name((rhs)) ==apply_general_tag &&`
		1338	`nstare == ass_tag && (nl.propsneeds &`
		1339	`(uses2_bit \| anyproccall)) == 0) {`
2	7u83	1340	`/* source is proc call, so assign result`
		1341	`reg directly */`
7	7u83	1342	`;`
2	7u83	1343	`}`
		1344	`else if (nr.fixneeds >= maxfix \|\| prps != 0) {`
		1345	`/* source and destination regs overlap, so identify source */`
7	7u83	1346	`cca(at, rhs);`
		1347	`nl = shapeneeds(sh(*(rhs)));`
2	7u83	1348	`nl.propsneeds \|= morefix;`
		1349	`nl.propsneeds &= ~(prps >> 1);`
		1350	`nl.propsneeds \|= prps;`
		1351	`}`
7	7u83	1352	`return maxneeds(nl, nr);`
2	7u83	1353	`}`
		1354	`}`
7	7u83	1355	`case untidy_return_tag:`
		1356	`case res_tag: {`
2	7u83	1357	`ash a;`
		1358	`needs x;`
		1359	`shape s;`
		1360	`exp * arg = &son(*e);`
		1361	`exp r, ss, t;`
7	7u83	1362	`s = sh(*(arg));`
		1363	`a = ashof(s);`
2	7u83	1364	`props(e) = 0; / clear possibility of tlrecirsion; may be set later */`
7	7u83	1365	`x = scan(arg, at);`
2	7u83	1366	`/* scan result exp ... */`
		1367	`if (is_floating (name (s))) {/* ... floating pt result */`
		1368	`x.propsneeds \|= realresult_bit;`
7	7u83	1369	`if (name(s)!= shrealhd) {`
2	7u83	1370	`x.propsneeds \|= longrealresult_bit;`
		1371	`}`
		1372	`}`
		1373	`else {`
		1374	`if (!valregable (s)) {/* .... result does not fit into reg */`
		1375	`x.propsneeds \|= long_result_bit;`
		1376	`}`
		1377	`}`
		1378	`if (a.ashsize != 0) { /* ...not a void result */`
		1379	`x.propsneeds \|= has_result_bit;`
		1380	`}`
7	7u83	1381
		1382	`if ((name(*e) == res_tag) &&`
		1383	`(x.propsneeds & (long_result_bit \| anyproccall \| uses2_bit)) == 0) {`
		1384	`r = son(*(e));`
		1385	`if (name(r) == ident_tag && isvar(r) &&`
		1386	`name(ss = bro(son(r))) == seq_tag &&`
		1387	`name(t = bro(son(ss))) == cont_tag &&`
		1388	`name(son(t)) == name_tag && son(son(t)) == r) {`
2	7u83	1389	`/* result is tag allocated into result reg`
		1390	`- see ident_tag: */`
7	7u83	1391	`if ((props(r) & inreg_bits)!= 0) {`
2	7u83	1392	`x.fixneeds--;`
		1393	`}`
7	7u83	1394	`else if ((props(r) & infreg_bits)!= 0) {`
2	7u83	1395	`x.floatneeds--;`
		1396	`}`
		1397	`else {`
7	7u83	1398	`props(r) \|= (is_floating(name(s)))? infreg_bits : inreg_bits;`
2	7u83	1399	`}`
		1400	`x.propsneeds \|= uses2_bit;`
7	7u83	1401	`no (r) = 101; /* identification uses result reg in body`
2	7u83	1402	`*/`
		1403	`}`
		1404	`}`
		1405	`return x;`
		1406	`}`
7	7u83	1407	`case apply_general_tag: {`
2	7u83	1408	`exp application = *(e);`
		1409	`exp *fn = &son(application);`
		1410	`exp callers = bro(*fn);`
		1411	`exp *cerl = &son(callers);`
		1412	`int stpar = 0;`
		1413	`needs nds,pstldnds;`
		1414	`int i;`
		1415	`gen_call = 1;`
		1416	`nds = scan(fn,at);`
		1417	`if(nds.propsneeds & hasproccall){ /* Identify it */`
		1418	`cca(at,fn);`
		1419	`nds.propsneeds &= ~hasproccall;`
		1420	`nds.propsneeds \|= usesproccall;`
		1421	`fn = &son(application);`
		1422	`}`
7	7u83	1423	`for (i=0;i<no(callers);++i) {`
2	7u83	1424	`needs onepar;`
		1425	`shape shonepar = sh(*cerl);`
7	7u83	1426	`exp * par = (name(cerl) ==caller_tag)?&son(cerl):cerl;`
2	7u83	1427	`int n = rounder(stpar,shape_align(shonepar));`
		1428	`onepar = scan(par,at);`
7	7u83	1429	`if (((i != 0) && (onepar.propsneeds & hasproccall)) \|\|`
		1430	`(onepar.fixneeds+ (stpar>>6) > maxfix)) {`
2	7u83	1431	`/* not the first parameter, and calls a proc */`
		1432	`cca(at,par);`
		1433	`nds.propsneeds \|= usesproccall;`
		1434	`nds = maxneeds(shapeneeds(sh(*(par))),nds);`
		1435	`nds.maxargs = max(nds.maxargs,onepar.maxargs);`
		1436	`}`
		1437	`else{`
		1438	`nds = maxneeds(onepar,nds);`
		1439	`}`
7	7u83	1440	`if (name(*cerl) == caller_tag) {`
2	7u83	1441	`no(*cerl) = n;`
		1442	`}`
		1443	`n += shape_size(shonepar);`
		1444	`stpar = rounder(n,REG_SIZE);`
		1445	`cerl = &bro(*cerl);`
		1446	`}`
		1447	`nds.maxargs = max(nds.maxargs,stpar);`
		1448	`nds = maxneeds(scan(&bro(bro(son(application))),at),nds);`
		1449	`pstldnds = scan(&bro(bro(bro(son(application)))),at);`
7	7u83	1450	`if (pstldnds.propsneeds & (anyproccall \| uses2_bit)) {`
2	7u83	1451	`props(*e) = 1;`
7	7u83	1452	`if (valregable(sh(application)) \|\| floatregable(sh(application))) {`
2	7u83	1453	`cca(at,ptr_position(application));`
		1454	`pstldnds.propsneeds \|= usesproccall;`
		1455	`}`
		1456	`}`
		1457	`else{`
		1458	`props(*e) = 0;`
		1459	`}`
		1460	`nds = maxneeds(nds,pstldnds);`
		1461	`nds.propsneeds \|= hasproccall;`
		1462	`return nds;`
		1463	`}`
7	7u83	1464	`case make_callee_list_tag: {`
2	7u83	1465	`exp cllees = *e;`
		1466	`exp *par = &son(cllees);`
		1467	`needs nds;`
		1468	`int stpar = 0,i;`
		1469	`nds = zeroneeds;`
7	7u83	1470	`for (i=0;i<no(cllees);++i) {`
2	7u83	1471	`needs onepar;`
		1472	`shape shonepar = sh(*par);`
		1473	`int n = rounder(stpar,shape_align(shonepar));`
		1474	`onepar = scan(par,at);`
7	7u83	1475	`if ((onepar.propsneeds & hasproccall) \|\| (onepar.fixneeds+1>maxfix)) {`
2	7u83	1476	`/* identify it */`
		1477	`cca(at,par);`
		1478	`nds.propsneeds \|= usesproccall;`
		1479	`nds = maxneeds(shapeneeds(sh(*par)),nds);`
		1480	`nds.maxargs = max(nds.maxargs,onepar.maxargs);`
		1481	`}`
		1482	`else{`
		1483	`nds = maxneeds(onepar,nds);`
		1484	`}`
		1485	`n += shape_size(shonepar);`
		1486	`stpar = rounder(n,REG_SIZE);`
		1487	`par = &bro(*par);`
		1488	`}`
		1489	`no(cllees) = stpar;`
		1490	`return nds;`
		1491	`}`
7	7u83	1492
		1493	`case make_dynamic_callee_tag: {`
2	7u83	1494	`exp callees = *e;`
		1495	`exp *ptr = &son(callees);`
		1496	`needs ndsp,nds;`
		1497	`nds = zeroneeds;`
		1498	`ndsp = scan(ptr,at);`
7	7u83	1499	`if ((ndsp.propsneeds & hasproccall) \|\| (ndsp.fixneeds+1 > maxfix)) {`
2	7u83	1500	`cca(at,ptr);`
		1501	`nds.propsneeds \|= usesproccall;`
		1502	`nds = maxneeds(shapeneeds(sh(*ptr)),nds);`
		1503	`nds.maxargs = max(nds.maxargs,ndsp.maxargs);`
		1504	`}`
		1505	`else{`
		1506	`nds = ndsp;`
		1507	`}`
		1508	`ndsp = scan(&bro(son(*e)),at);`
7	7u83	1509	`if ((ndsp.propsneeds & hasproccall) \|\| (ndsp.fixneeds+2 > maxfix)) {`
2	7u83	1510	`cca(at,&bro(son(callees)));`
		1511	`nds.propsneeds \|= usesproccall;`
		1512	`nds = maxneeds(shapeneeds(sh(bro(son(*e)))),nds);`
		1513	`nds.maxargs = max(nds.maxargs,ndsp.maxargs);`
		1514	`}`
		1515	`else{`
		1516	`nds = maxneeds(ndsp,nds);`
		1517	`}`
		1518	`if(nds.fixneeds<5) nds.fixneeds = 5; /* ?? */`
		1519	`return nds;`
		1520	`}`
7	7u83	1521
		1522	`case same_callees_tag: {`
2	7u83	1523	`needs nds;`
		1524	`nds = zeroneeds;`
		1525	`nds.fixneeds = 4; /* ?? */`
		1526	`return nds;`
		1527	`}`
		1528
7	7u83	1529	`case tail_call_tag: {`
2	7u83	1530	`needs ndsp,nds;`
		1531	`exp fn = &son(e);`
		1532	`ndsp = scan(fn,at);`
7	7u83	1533	`if ((ndsp.propsneeds & hasproccall) \|\| (ndsp.fixneeds+1 > maxfix)) {`
2	7u83	1534	`cca(at,fn);`
		1535	`nds.propsneeds \|= usesproccall;`
		1536	`nds = maxneeds(shapeneeds(sh(*fn)),nds);`
		1537	`nds.maxargs = max(nds.maxargs,ndsp.maxargs);`
		1538	`}`
		1539	`else{`
		1540	`nds = ndsp;`
		1541	`}`
		1542	`gen_call = 1;`
		1543	`ndsp = scan(&bro(son(*e)),at);`
		1544	`nds = maxneeds(nds,ndsp);`
		1545	`return nds;`
		1546	`}`
		1547
7	7u83	1548	`case apply_tag: {`
2	7u83	1549	`exp application = *(e);`
7	7u83	1550	`exp fn = son(application);`
2	7u83	1551	`exp * par = &bro(fn);`
		1552	`exp * fnexp = &son(*e);`
		1553	`int parsize =0;`
		1554	`needs nds;`
		1555	`bool tlrecpos = nonevis && callerfortr && (rscope_level == 0);`
		1556	`int i;`
7	7u83	1557
		1558	`nds = scan(fnexp, at);`
2	7u83	1559	`/* scan the function exp ... */`
7	7u83	1560	`if ((nds.propsneeds & hasproccall)!= 0) {`
2	7u83	1561	`/* .... it must be identified */`
7	7u83	1562	`cca(at, fnexp);`
2	7u83	1563	`nds.propsneeds &= ~hasproccall;`
		1564	`nds.propsneeds \|= usesproccall;`
		1565	`fn = son(application);`
		1566	`par = &bro(fn);`
		1567	`}`
		1568
7	7u83	1569	`if (name(fn)!= name_tag \|\|`
		1570	`(son(son(fn))!= nilexp && name(son(son(fn)))!= proc_tag)) {`
2	7u83	1571	`tlrecpos = 0;`
		1572	`}`
		1573
		1574	`for (i = 1;!last(fn); ++i) { /* scan parameters in turn ... */`
		1575	`needs onepar;`
		1576	`shape shpar = sh(*par);`
7	7u83	1577	`onepar = scan(par, at);`
		1578
		1579	`if ((i != 1 && (onepar.propsneeds & hasproccall)!= 0) \|\|`
		1580	`onepar.fixneeds+ (parsize>>6) > maxfix) {`
2	7u83	1581	`/* if it isn't the first parameter, and it`
		1582	`calls a proc, identify it */`
7	7u83	1583	`cca(at, par);`
2	7u83	1584	`nds.propsneeds \|= usesproccall;`
7	7u83	1585	`nds = maxneeds(shapeneeds(sh(*(par))), nds);`
		1586	`nds.maxargs = max(nds.maxargs, onepar.maxargs);`
2	7u83	1587	`}`
		1588	`else {`
7	7u83	1589	`nds = maxneeds(onepar, nds);`
2	7u83	1590	`}`
		1591	`parsize = rounder(parsize, shape_align(shpar));`
		1592	`parsize = rounder(parsize+shape_size(shpar), REG_SIZE);`
		1593	`/* ? */`
		1594	`if ((!valregable(shpar) && !is_floating(name(shpar))) \|\| parsize > 384) {`
		1595	`tlrecpos = 0;`
7	7u83	1596	`}`
		1597	`if (last(*(par))) {`
2	7u83	1598	`break;`
7	7u83	1599	`}`
2	7u83	1600	`par = &bro(*par);`
		1601	`}`
		1602	`#if DO_SPECIAL`
		1603	`if ((i = specialfn (fn)) > 0) {/* eg strlen */`
7	7u83	1604	`nds = maxneeds(specialneeds(i), nds);`
2	7u83	1605	`return nds;`
		1606	`}`
7	7u83	1607	`else`
2	7u83	1608	`if (i == -1) { /* call of strcpy .... */`
7	7u83	1609	`exp par2 = *(par);`
		1610	`/* TEST for constant string?????????????????`
2	7u83	1611	`if (name (par2) == eval_tag && name (son (par2)) == pack_tag`
		1612	`&& name (son (son (par2))) == string_tag) {`
		1613	`setname (* (e), ass_tag);`
		1614	`son (* (e)) = * (parlist);`
		1615	`son (par2) = son (son (par2));`
		1616	`sh (par2) = sh (son (par2));`
		1617	`bro (par2) = * (e) ;`
7	7u83	1618	`bro(son(par2)) = par2;`
2	7u83	1619	`return maxneeds (nds, twofix);`
		1620	`}`
		1621	`*/`
		1622	`}`
7	7u83	1623	`#endif`
2	7u83	1624	`if (tlrecpos) {`
		1625	`exp dad = father(application);`
7	7u83	1626	`if (name(dad) ==res_tag) {`
2	7u83	1627	`props(dad) = 1; /* do a tl recursion*/`
		1628	`}`
		1629	`}`
		1630	`nds.propsneeds \|= hasproccall;`
7	7u83	1631	`nds.maxargs = max(nds.maxargs, parsize);`
2	7u83	1632	`return nds;`
7	7u83	1633
2	7u83	1634	`}`
		1635
7	7u83	1636	`case name_tag: {`
		1637	`if (is_vararg(*e)) {`
2	7u83	1638	`/* if the tag represents va_list (set in spec_toks.c) */`
		1639	`has_old_varargs = 1;`
		1640	`}`
7	7u83	1641	`return shapeneeds(sh(*(e)));`
2	7u83	1642	`}`
		1643
7	7u83	1644	`case val_tag: {`
2	7u83	1645	`exp s = sh(*e);`
7	7u83	1646	`if (name(s) ==offsethd && al2(s) >= 8) {`
2	7u83	1647	`/* express disps in bytes */`
		1648	`no(e) = no(e) >>3;`
		1649	`}`
		1650	`/... and continue /`
		1651	`}`
		1652	`FALL_THROUGH;`
7	7u83	1653	`case env_size_tag:`
		1654	`case give_stack_limit_tag:`
		1655	`case null_tag:`
		1656	`case real_tag:`
		1657	`case string_tag:`
		1658	`case env_offset_tag:`
		1659	`case general_env_offset_tag:`
		1660	`case caller_name_tag:`
2	7u83	1661	`/* case next_frame_tag :*/`
7	7u83	1662	`case current_env_tag:`
		1663	`case make_lv_tag:`
		1664	`case last_local_tag:{`
		1665	`return shapeneeds(sh(*(e)));`
2	7u83	1666	`}`
7	7u83	1667
		1668	`case clear_tag:`
		1669	`case formal_callee_tag:`
		1670	`case top_tag:`
		1671	`case prof_tag:`
		1672	`case local_free_all_tag:{`
2	7u83	1673	`return zeroneeds;`
		1674	`}`
7	7u83	1675	`case set_stack_limit_tag:`
2	7u83	1676	`#ifdef return_to_label_tag`
7	7u83	1677	`case return_to_label_tag:`
2	7u83	1678	`#endif`
7	7u83	1679	`case diagnose_tag:`
		1680	`case neg_tag:`
		1681	`case case_tag:`
		1682	`case not_tag:`
		1683	`case offset_negate_tag:`
		1684	`case absbool_tag:`
		1685	`case goto_lv_tag:`
		1686	`case abs_tag:`
		1687	`case local_free_tag:{`
2	7u83	1688	`exp * arg = &son(*e);`
7	7u83	1689	`return scan(arg, at);`
2	7u83	1690	`}`
7	7u83	1691	`case fneg_tag:`
		1692	`case fabs_tag:`
		1693	`case chfl_tag: {`
2	7u83	1694	`needs nds;`
		1695	`nds = scan(&son(*e), at);`
7	7u83	1696	`if (!optop(*e) && nds.fixneeds <2)nds.fixneeds = 2;`
2	7u83	1697	`return nds;`
		1698	`}`
7	7u83	1699
		1700	`case alloca_tag: {`
2	7u83	1701	`needs nds;`
		1702	`nds = scan(&son(*e), at);`
7	7u83	1703	`if (nds.fixneeds <2)nds.fixneeds = 2;`
2	7u83	1704	`return nds;`
7	7u83	1705	`}`
		1706	`case bitf_to_int_tag: {`
2	7u83	1707	`/* is bitfield signed or unsigned ?? */`
		1708	`exp * arg = &son(*e);`
		1709	`needs nds;`
		1710	`exp stararg;`
		1711	`exp stare;`
		1712	`int sizeb;`
7	7u83	1713
		1714	`nds = scan(arg, at);`
2	7u83	1715	`stararg = *(arg);`
7	7u83	1716	`stare = *(e);`
		1717	`sizeb = ashof(sh(stararg)).ashsize;`
		1718	`if ((name(stararg) ==name_tag &&`
		1719	`((sizeb == 8 && (no(stararg) & 7) == 0)`
		1720	`\|\| (sizeb == 16 && (no(stararg) & 15) == 0)`
		1721	`\|\| (sizeb == 32 && (no(stararg) & 31) == 0)`
2	7u83	1722	`\|\| (sizeb == 64 && (no(stararg) & 63) ==0)`
7	7u83	1723	`)`
		1724	`) \|\| (name(stararg) ==cont_tag &&`
		1725	`((name(son(stararg))!= name_tag &&`
2	7u83	1726	`name(son(stararg))!=reff_tag)`
7	7u83	1727	`\|\| (sizeb == 8 && (no(son(stararg)) & 7) == 0)`
		1728	`\|\| (sizeb == 16 && (no(son(stararg)) & 15) == 0)`
		1729	`\|\| (sizeb == 32 && (no(son(stararg)) & 31) == 0)`
		1730	`\|\| (sizeb == 64 && (no(son(stararg)) & 63) == 0)`
		1731	`)`
		1732	`)`
		1733	`) {`
2	7u83	1734	`bool sgned = name(sh(stare)) & 1;`
7	7u83	1735	`shape ns = (sizeb==8)?((sgned)?scharsh:ucharsh)`
		1736	`:(sizeb==16)?((sgned)?swordsh:uwordsh)`
2	7u83	1737	`: sh(stare);`
		1738	`/* can use short loads instead of bits extractions*/`
7	7u83	1739	`if (name(stararg) ==cont_tag) {`
2	7u83	1740	`/* make the ptr shape consistent */`
		1741	`sh(son(stararg)) = f_pointer(long_to_al(shape_align(ns)));`
		1742	`}`
		1743	`sh(stararg) = ns;`
		1744	`setname(stare, chvar_tag);`
7	7u83	1745	`}`
2	7u83	1746	`return nds;`
		1747	`}`
7	7u83	1748
		1749	`case int_to_bitf_tag: {`
2	7u83	1750	`exp * arg = &son(*e);`
7	7u83	1751	`return scan(arg, at);`
2	7u83	1752	`}`
7	7u83	1753
		1754	`case round_tag: {`
2	7u83	1755	`needs s;`
		1756	`exp * arg = &son(*e);`
7	7u83	1757	`s = scan(arg, at);`
		1758	`s.fixneeds = max(s.fixneeds, 2);`
		1759	`s.floatneeds = max(s.floatneeds, 2);`
2	7u83	1760	`has_float = 1;`
		1761	`return s;`
		1762	`}`
7	7u83	1763
		1764	`case shl_tag:`
		1765	`case shr_tag:`
		1766	`case long_jump_tag: {`
2	7u83	1767	`exp * lhs = &son(*e);`
		1768	`exp * rhs = & bro(*lhs);`
		1769	`needs nr;`
		1770	`needs nl;`
7	7u83	1771	`prop prps;`
2	7u83	1772	`nr = scan(rhs, at);`
7	7u83	1773	`nl = scan(lhs, at);`
2	7u83	1774	`rhs = &bro(*lhs);`
		1775	`prps = (nr.propsneeds & hasproccall) << 1;`
		1776	`if (nr.fixneeds >= maxfix \|\| prps != 0) {`
		1777	`/* if reg requirements overlap, identify`
		1778	`second operand */`
7	7u83	1779	`cca(at, rhs);`
		1780	`nl = shapeneeds(sh(*(rhs)));`
2	7u83	1781	`nl.propsneeds \|= morefix;`
		1782	`nl.propsneeds &= ~(prps >> 1);`
		1783	`nl.propsneeds \|= prps;`
		1784	`}`
		1785	`nr.fixneeds += 1;`
7	7u83	1786	`return maxneeds(nl, nr);`
		1787
2	7u83	1788	`}`
7	7u83	1789
		1790	`case test_tag: {`
2	7u83	1791	`exp stare = *(e);`
7	7u83	1792	`exp l = son(stare);`
		1793	`exp r = bro(l);`
2	7u83	1794	`exp dad = father(stare);`
7	7u83	1795	`bool xlike = (name(dad) ==maxlike_tag \|\| name(dad) ==minlike_tag \|\| name(dad) ==abslike_tag);`
2	7u83	1796	`/* don't do various optimisations if xlike */`
7	7u83	1797
		1798	`if (!last(stare) && name(bro(stare)) == test_tag &&`
		1799	`no(stare) == no(bro(stare)) &&`
		1800	`props(stare) ==props(bro(stare)) &&`
		1801	`eq_exp(l, son(bro(stare))) && eq_exp(r, bro(son(bro(stare))))`
2	7u83	1802	`) { /* same test following in seq list -`
		1803	`remove second test */`
7	7u83	1804	`if (last(bro(stare)))`
		1805	`setlast(stare);`
		1806	`bro(stare) = bro(bro(stare));`
2	7u83	1807	`}`
7	7u83	1808
2	7u83	1809	`if (last (stare) && name (bro (stare)) == 0/* seq holder */`
7	7u83	1810	`&& name(bro(bro(stare))) == test_tag &&`
		1811	`name(bro(bro(bro(stare)))) == seq_tag &&`
		1812	`no(stare) == no(bro(bro(stare))) &&`
		1813	`props(stare) ==props(bro(bro(stare))) &&`
		1814	`eq_exp(l, son(bro(bro(stare))))`
		1815	`&& eq_exp(r, bro(son(bro(bro(stare)))))`
2	7u83	1816	`) { /* same test following in seq res - void`
		1817	`second test */`
7	7u83	1818	`setname(bro(bro(stare)), top_tag);`
		1819	`son(bro(bro(stare))) = nilexp;`
		1820	`pt(bro(bro(stare))) = nilexp;`
2	7u83	1821	`}`
7	7u83	1822
		1823	`if (!xlike && name(l) == val_tag && (props(stare) == 5 \|\| props(stare) == 6)) {`
2	7u83	1824	`/* commute const = x */`
7	7u83	1825	`bro(l) = stare;`
		1826	`setlast(l);`
		1827	`bro(r) = l;`
		1828	`clearlast(r);`
		1829	`son(stare) = r;`
2	7u83	1830	`r = l;`
7	7u83	1831	`l = son(stare);`
2	7u83	1832	`}`
7	7u83	1833
		1834	`if (!xlike && name(r) == val_tag && (props(stare) == 5`
		1835	`\|\| props(stare) == 6) && no(r) == 0 &&`
		1836	`name(l) == and_tag && name(bro(son(l))) == val_tag &&`
		1837	`(no(bro(son(l))) & (no(bro(son(l))) - 1)) == 0`
		1838	`) {`
2	7u83	1839	`/* zero test x & 2^n -> neg test (x shl`
		1840	`(31-n)) */`
		1841	`exp copy;`
		1842	`INT64 n = isbigval(bro(son(l)))?exp_to_INT64((bro(son(l)))):`
7	7u83	1843	`make_INT64(0,no(bro(son(l))));`
2	7u83	1844	`int x;`
7	7u83	1845	`for (x = 0; INT64_lt(zero_int64,n);++x) {`
2	7u83	1846	`/* for (x = 0; n > 0; x++) {*/`
		1847	`n = INT64_shift_left(n,1,1);`
		1848	`/n = n << 1;/`
		1849	`}`
		1850	`if (x == 0) { /* no shift required */`
		1851	`bro (son (l)) = r; /* zero there */`
		1852	`son (stare) = son (l);/* x */`
		1853	`}`
		1854	`else {`
7	7u83	1855	`setname(l, shl_tag);`
		1856	`no(bro(son(l))) = x;`
2	7u83	1857	`}`
		1858	`props (stare) -= 3; /* test for neg */`
7	7u83	1859	`if (!is64(sh(son(stare))) && name(l)!=shl_tag) {`
2	7u83	1860	`sh(son(stare)) = slongsh;`
		1861	`copy = getexp(s64sh,bro(son(stare)),0,son(stare),nilexp,0,0,`
		1862	`chvar_tag);`
		1863	`son(stare) = copy;`
		1864	`}`
		1865	`else{`
		1866	`sh(son(stare)) = s64sh;`
		1867	`}`
7	7u83	1868
2	7u83	1869	`}`
7	7u83	1870	`if (name(l) == bitf_to_int_tag && name(r) == val_tag &&`
		1871	`(props(stare) == 5 \|\| props(stare) == 6) &&`
		1872	`(name(son(l)) == cont_tag \|\| name(son(l)) == name_tag)) {`
2	7u83	1873	`/* equality of bits against +ve consts`
		1874	`doesnt need sign adjustment */`
7	7u83	1875	`long n = no(r);`
		1876	`switch (name(sh(l))) {`
		1877	`case scharhd: {`
2	7u83	1878	`if (n >= 0 && n <= 127) {`
7	7u83	1879	`sh(l) = ucharsh;`
2	7u83	1880	`} break;`
		1881	`}`
7	7u83	1882	`case swordhd: {`
2	7u83	1883	`if (n >= 0 && n <= 0xffff) {`
7	7u83	1884	`sh(l) = uwordsh;`
2	7u83	1885	`} break;`
		1886	`}`
7	7u83	1887	`default:;`
2	7u83	1888	`}`
7	7u83	1889	`}`
		1890	`else if (is_floating(name(sh(l)))) {`
		1891	`return fpop(e, at);`
		1892	`}`
		1893	`else if (!xlike && name(r) == val_tag && no(r) == 1 && !isbigval(r)`
		1894	`&& (props(stare) == 3 \|\| props(stare) == 2)) {`
		1895	`no(r) = 0;`
		1896	`if (props(stare) == 3) {`
2	7u83	1897	`props (stare) = 4;/* branch >=1 -> branch > 0 */`
7	7u83	1898	`}`
2	7u83	1899	`else {`
		1900	`props (stare) = 1;/* branch <1 -> branch <= 0 */`
7	7u83	1901	`}`
2	7u83	1902	`}`
7	7u83	1903	`return likediv(e, at);`
2	7u83	1904	`}`
7	7u83	1905	`case plus_tag:{`
2	7u83	1906	`/* replace any operands which are neg(..)`
		1907	`by - ,if poss */`
7	7u83	1908	`exp sum = *(e);`
		1909	`exp list = son(sum);`
2	7u83	1910	`bool someneg = 0;`
		1911	`bool allneg = 1;`
		1912	`for (;optop(sum);) {`
7	7u83	1913	`if (name(list) == neg_tag)`
2	7u83	1914	`someneg = 1;`
		1915	`else`
		1916	`allneg = 0;`
7	7u83	1917	`if (last(list))`
2	7u83	1918	`break;`
7	7u83	1919	`list = bro(list);`
2	7u83	1920	`}`
7	7u83	1921
2	7u83	1922	`if (someneg) { /* there are some neg() operands */`
		1923	`if (allneg) {`
		1924	`/* transform -..-... to -(..+.. +...) */`
7	7u83	1925	`exp x = son(sum);`
		1926	`list = son(x);`
2	7u83	1927	`/* ALTERATION #1 here to fix minor structural bug */`
		1928	`for (;;) {`
7	7u83	1929	`if (!last(x)) {`
		1930	`bro(list) = son(bro(x));`
		1931	`clearlast(list);`
		1932	`list = bro(list);`
		1933	`x = bro(x);`
2	7u83	1934	`}`
		1935	`else {`
		1936	`bro(list) = sum;`
7	7u83	1937	`setlast(list);`
		1938	`son(sum) = son(son(sum));`
2	7u83	1939	`/* use existing exp */`
		1940	`break;`
		1941	`}`
		1942	`}`
7	7u83	1943	`x = getexp(sh(sum), bro(sum), last(sum), sum, nilexp,`
2	7u83	1944	`0, 0, neg_tag);`
		1945	`setlast(sum); bro(sum)=x; /* set father of sum to be negate */`
7	7u83	1946	`*(e) = x;`
		1947
2	7u83	1948	`} /* end allneg */`
		1949	`else {`
		1950	`/* transform to ((..(..+..) - ..) -..) */`
		1951	`int n = 0;`
7	7u83	1952	`exp brosum = bro(sum);`
		1953	`bool lastsum = last(sum);`
		1954	`exp x = son(sum);`
2	7u83	1955	`exp newsum = sum;`
		1956	`list = nilexp;`
		1957	`for (;;) {`
7	7u83	1958	`exp nxt = bro(x);`
		1959	`bool final = last(x);`
		1960	`if (name(x) == neg_tag) {`
		1961	`bro(son(x)) = list;`
		1962	`list = son(x);`
2	7u83	1963	`}`
		1964	`else {`
7	7u83	1965	`bro(x) = newsum;`
2	7u83	1966	`newsum = x;`
		1967	`if ((n++) == 0)`
7	7u83	1968	`setlast(newsum);`
2	7u83	1969	`else`
7	7u83	1970	`clearlast(newsum);`
2	7u83	1971	`}`
		1972	`if (final)`
		1973	`break;`
		1974	`x = nxt;`
		1975	`}`
7	7u83	1976
2	7u83	1977	`if (n > 1) {`
7	7u83	1978	`son(sum) = newsum;`
2	7u83	1979	`newsum = sum; /* use existing exp for add operations */`
		1980	`}`
		1981	`for (;;) { /* introduce - operations */`
7	7u83	1982	`exp nxt = bro(list);`
		1983	`bro(newsum) = list;`
		1984	`clearlast(newsum);`
		1985	`x = getexp(sh(sum), nilexp, 0, newsum, nilexp, 0, 0, minus_tag);`
		1986
		1987	`bro(list) = x;`
		1988	`setlast(list);`
2	7u83	1989	`newsum = x;`
		1990	`if ((list = nxt) == nilexp)`
		1991	`break;`
		1992	`}`
7	7u83	1993	`bro(newsum) = brosum;`
2	7u83	1994	`if (lastsum) {`
7	7u83	1995	`setlast(newsum);`
2	7u83	1996	`}`
		1997	`else {`
7	7u83	1998	`clearlast(newsum);`
2	7u83	1999	`}`
7	7u83	2000	`*(e) = newsum;`
		2001
2	7u83	2002	`} /* end else allneg */`
7	7u83	2003
		2004	`return scan(e, at);`
		2005
2	7u83	2006	`} /* end someneg - else continue to next`
		2007	`case */`
		2008	`}`
		2009	`FALL_THROUGH`
7	7u83	2010	`case and_tag:`
		2011	`case mult_tag:`
		2012	`case or_tag:`
		2013	`case xor_tag: {`
		2014	`return likeplus(e, at);`
2	7u83	2015	`}`
7	7u83	2016	`case addptr_tag: {`
2	7u83	2017	`exp ptr_arg = son(*e);`
		2018	`exp offset_arg = bro(ptr_arg);`
		2019	`int fralign = frame_al_of_ptr(sh(ptr_arg));`
7	7u83	2020	`if (fralign) {`
2	7u83	2021	`int offalign = frame_al1_of_offset(sh(offset_arg));`
		2022	`#if 0`
7	7u83	2023	`if (((offalign-1) &offalign)!= 0) {`
2	7u83	2024	`failer("Mixed frame offsets not supported");`
		2025	`}`
		2026	`#endif`
7	7u83	2027	`if (includes_vcallees(fralign) && l_or_cees(offalign)) {`
2	7u83	2028	`exp newexp = getexp(sh(ptr_arg),offset_arg,0,ptr_arg,nilexp,0,0,`
		2029	`locptr_tag);`
		2030	`bro(ptr_arg) = newexp;`
		2031	`setlast(ptr_arg);`
		2032	`son(*e) = newexp;`
		2033	`}`
		2034	`}`
		2035	`return likediv(e,at);`
		2036	`}`
7	7u83	2037	`case locptr_tag:`
		2038	`case reff_tag:`
		2039	`case offset_pad_tag:`
		2040	`case chvar_tag: {`
2	7u83	2041	`exp * arg = &son(*e);`
		2042	`needs nds;`
7	7u83	2043	`nds = maxneeds(scan(arg, at),shapeneeds(sh(*(e))));`
2	7u83	2044	`/* nds.fixneeds += 1;*/`
		2045	`return nds;`
		2046	`}`
7	7u83	2047
		2048	`case float_tag: {`
		2049	`needs nds;`
2	7u83	2050	`exp * arg = &son(*e);`
7	7u83	2051	`nds = maxneeds(scan(arg, at), shapeneeds(sh(*(e))));`
		2052	`if ((name(sh(son((e)))) == ulonghd) \|\| (name(sh(son((e)))) ==u64hd)) {`
2	7u83	2053	`if (nds.floatneeds <2) nds.floatneeds =2; /* remove */`
		2054	`}`
		2055	`has_float = 1;`
		2056	`return nds;`
7	7u83	2057	`}`
		2058	`case cont_tag:`
		2059	`case contvol_tag: {`
2	7u83	2060	`exp * arg = &son(*e);`
		2061	`needs nds;`
7	7u83	2062
		2063	`nds = maxneeds(scan(arg, at), shapeneeds(sh(*(e))));`
		2064	`if (is_awkward_variety(name(sh(*e)))) {`
2	7u83	2065	`nds.fixneeds = max(nds.fixneeds,4);`
		2066	`}`
		2067	`else{`
7	7u83	2068	`nds.fixneeds = max(nds.fixneeds, 2);`
2	7u83	2069	`}`
		2070	`if (nstare != cont_tag) {`
		2071	`nds.propsneeds \|= uses2_bit;`
		2072	`}`
		2073	`return nds;`
7	7u83	2074	`}`
		2075
		2076	`case offset_mult_tag:`
		2077	`case offset_div_tag: {`
2	7u83	2078	`exp op2 = bro(son(*e));`
		2079	`shape s = sh(op2);`
7	7u83	2080	`if (name(op2) ==val_tag && no(op2) == 8 && name(s) ==offsethd && al2(s) >= 8) {`
2	7u83	2081	`/* offset is one byte */`
		2082	`exp op1 = son(*e);`
		2083	`bro(op1) = bro(*e);`
		2084	`if (last(*e)) { setlast(op1); } else {clearlast(op1); }`
		2085	`*e = op1;`
7	7u83	2086	`return(scan(e, at));`
2	7u83	2087	`}`
		2088	`/... else continue /`
		2089	`}`
		2090	`FALL_THROUGH;`
7	7u83	2091	`case div2_tag:`
		2092	`case rem2_tag:`
		2093	`case rem0_tag:`
		2094	`case div0_tag:`
		2095	`case offset_div_by_int_tag:{`
		2096	`if (is_machine_divide(*e)) {`
2	7u83	2097	`has_div = 1;`
		2098	`}`
		2099	`return likediv(e,at);`
		2100	`}`
7	7u83	2101	`case offset_add_tag:`
		2102	`case offset_subtract_tag: {`
		2103	`if ((al2(sh(son(e))) == 1) && (al2(sh(bro(son(e))))!= 1)) {`
2	7u83	2104	`make_bitfield_offset(bro(son(e)),son(e),0,sh(*e));`
		2105	`}`
7	7u83	2106	`if ((al2(sh(son(e)))!= 1) && (al2(sh(bro(son(e)))) == 1)) {`
2	7u83	2107	`make_bitfield_offset(son(e),e,1,sh(*e));`
		2108	`}`
		2109	`}`
		2110	`FALL_THROUGH;`
		2111	`#ifdef make_stack_limit_tag`
7	7u83	2112	`case make_stack_limit_tag:`
2	7u83	2113	`#endif`
7	7u83	2114	`case min_tag:`
		2115	`case max_tag:`
		2116	`case minus_tag:`
		2117	`case subptr_tag:`
		2118	`case minptr_tag:`
		2119	`case offset_max_tag:`
		2120	`case component_tag:{`
		2121	`return likediv(e, at);`
2	7u83	2122	`}`
7	7u83	2123	`case div1_tag: {`
		2124	`if (is_machine_divide(*e)) {`
2	7u83	2125	`has_div = 1;`
		2126	`}`
7	7u83	2127	`if ((name(sh(e)) & 1) ==0) { setname(e, div2_tag); }`
2	7u83	2128	`return likediv(e,at);`
		2129	`}`
7	7u83	2130	`case mod_tag: {`
		2131	`if (is_machine_divide(*e)) {`
2	7u83	2132	`has_div = 1;`
		2133	`}`
7	7u83	2134	`if ((name(sh(e)) & 1) ==0) { setname(e, rem2_tag); }`
2	7u83	2135	`return likediv(e,at);`
		2136	`}`
7	7u83	2137	`case fdiv_tag:`
2	7u83	2138	`#if (FBASE==10) /* (FBASE==10) is now defunct */`
		2139	`{`
		2140	`/* replace X/const by Xconst^-1 /`
7	7u83	2141	`exp z = *(e);`
		2142	`exp a2 = bro(son(z));`
		2143	`if (name(a2) == real_tag) {`
2	7u83	2144	`flt inverse;`
		2145	`flt unitflt;`
7	7u83	2146	`str2flt("1.0", &unitflt,(char **)0);`
		2147	`if (flt_div(unitflt, flptnos[no(a2)], &inverse) == OKAY) {`
		2148
		2149	`int f = new_flpt();`
2	7u83	2150	`flptnos[f] = inverse;`
7	7u83	2151	`no(a2) = f;`
		2152	`setname(z, fmult_tag);`
2	7u83	2153	`}`
		2154	`}`
		2155	`}`
		2156	`#endif`
7	7u83	2157	`case fplus_tag:`
		2158	`case fminus_tag:`
		2159	`case fmult_tag: {`
2	7u83	2160	`exp op = *(e);`
		2161	`exp a2 = bro(son(op));`
		2162	`has_float = 1;`
7	7u83	2163	`if (!last(a2)) {`
		2164	`/* + and * can have >2 parameters`
2	7u83	2165	`- make them diadic - can do better`
		2166	`a+exp => let x = exp in a+x */`
		2167	`exp opn = getexp(sh(op), op, 0, a2, nilexp, 0, 0, name(op));`
		2168	`/* dont need to transfer error treatment - nans */`
		2169	`exp nd = getexp(sh(op), bro(op), last(op), opn, nilexp, 0, 1,`
		2170	`ident_tag);`
		2171	`exp id = getexp(sh(op), op, 1, nd, nilexp, 0, 0, name_tag);`
		2172	`pt(nd) = id;`
		2173	`bro(son(op)) = id;`
		2174	`setlast(op); bro(op) = nd;`
7	7u83	2175	`while (!last(a2))a2 = bro(a2);`
2	7u83	2176	`bro(a2) = opn;`
		2177	`*(e) = nd;`
		2178	`return scan(e, at);`
7	7u83	2179	`}`
		2180
		2181	`return fpop(e, at);`
2	7u83	2182	`}`
		2183
7	7u83	2184	`case fmax_tag: {`
2	7u83	2185	`has_float = 1;`
		2186	`return fpop(e,at);`
		2187	`}`
7	7u83	2188
		2189	`case field_tag: {`
2	7u83	2190	`needs str;`
		2191	`exp * arg = &son(*e);`
		2192	`if (chase(e, arg)) { / field has been distributed */`
		2193	`exp stare = *e;`
7	7u83	2194	`exp ss = son(stare);`
		2195	`if (!last(stare))`
		2196	`clearlast(ss);`
		2197	`bro(ss) = bro(stare);`
		2198	`sh(ss) = sh(stare);`
2	7u83	2199	`*e = ss;`
7	7u83	2200	`return(scan(e, at));`
		2201	`}`
		2202	`str = scan(arg, at);`
		2203	`return maxneeds(str, shapeneeds(sh(*(e))));`
2	7u83	2204	`}`
7	7u83	2205	`case general_proc_tag:`
		2206	`case proc_tag:{`
		2207	`exp * bexp;`
2	7u83	2208	`exp * bat;`
		2209	`needs body;`
		2210	`exp stare = *(e);`
7	7u83	2211	`callerfortr = do_tlrecursion && !proc_has_setjmp(stare)`
		2212	`&& !proc_has_alloca(stare) && !proc_has_lv(stare) &&`
		2213	`!proc_uses_crt_env(stare);`
2	7u83	2214	`callerfortr=0;`
		2215	`maxfix = 12; /* excluding regs corrupted by div */`
		2216	`maxfloat = 12; /* jm - 21? */`
		2217	`stparam = 0;`
		2218	`fixparam = 16;`
		2219	`floatparam = 16;`
		2220	`nonevis = 1;`
7	7u83	2221	`rscope_level = 0;`
2	7u83	2222	`numparams=0;`
		2223	`callee_size = 0;`
		2224	`gen_call = (name(stare) == general_proc_tag);`
		2225	`in_vcallers_proc = (gen_call && proc_has_vcallers(stare));`
7	7u83	2226	`bexp = & son(*e);`
2	7u83	2227	`bat = bexp;`
7	7u83	2228	`body = scan(bexp, &bat);`
2	7u83	2229	`/* scan the body of the proc */`
7	7u83	2230	`if (gen_call \|\| Has_fp) {`
2	7u83	2231	`/* reserve space for the link area */`
		2232	`callee_size += 4*PTR_SZ;`
		2233	`}`
		2234	`#if 0`
7	7u83	2235	`if (name(stare) == proc_tag && gen_call) {`
2	7u83	2236	`set_proc_has_gen_call(*e);`
		2237	`}`
		2238
7	7u83	2239	`#endif`
		2240	`if (has_old_varargs) {`
2	7u83	2241	`set_has_c_vararg(*e);`
		2242	`has_old_varargs = 0;`
		2243	`}`
7	7u83	2244	`if (has_div) {`
2	7u83	2245	`set_has_machine_division(*e);`
		2246	`has_div = 0;`
		2247	`}`
7	7u83	2248	`if (has_float) {`
		2249	`set_has_float(e); / need to allocate space on stack for`
2	7u83	2250	`a float <-> int register move */`
		2251	`}`
		2252	`return body; /* should never require this in reg in C */`
		2253	`}`
7	7u83	2254	`case movecont_tag: {`
2	7u83	2255	`exp * d = &son(*e);`
		2256	`exp * s = & bro(*d);`
		2257	`exp * sz = &bro(*s);`
		2258	`needs nd;`
		2259	`needs ns;`
		2260	`needs nsz;`
7	7u83	2261	`prop prps;`
2	7u83	2262	`nd = scan(d, at);`
7	7u83	2263	`ns = scan(s, at);`
2	7u83	2264	`nsz = scan(sz, at);`
		2265	`prps = (ns.propsneeds & hasproccall) << 1;`
		2266	`if (ns.fixneeds >= maxfix \|\| prps != 0) {`
		2267	`/* if reg requirements overlap, identify`
		2268	`second operand */`
7	7u83	2269	`cca(at, s);`
		2270	`ns = shapeneeds(sh(*(s)));`
2	7u83	2271	`ns.propsneeds \|= morefix;`
		2272	`ns.propsneeds &= ~(prps >> 1);`
		2273	`ns.propsneeds \|= prps;`
		2274	`}`
		2275	`nd.fixneeds += 1;`
		2276	`nd = maxneeds (nd, ns); /* ns? */`
		2277	`prps= (nsz.propsneeds & hasproccall) << 1;`
		2278	`if (nd.fixneeds+nsz.fixneeds >= maxfix \|\| prps != 0) {`
		2279	`/* if reg requirements overlap, identify last operand */`
7	7u83	2280	`cca(at, sz);`
		2281	`nsz = shapeneeds(sh(*(sz)));`
2	7u83	2282	`nsz.propsneeds \|= morefix;`
		2283	`nsz.propsneeds &= ~(prps >> 1);`
		2284	`nsz.propsneeds \|= prps;`
7	7u83	2285	`}`
2	7u83	2286	`nd.fixneeds+=1;`
		2287	`nd = maxneeds(nd,nsz);`
7	7u83	2288	`if (nd.fixneeds < 4)nd.fixneeds = 3;`
2	7u83	2289	`return nd;`
		2290	`}`
7	7u83	2291	`case trap_tag:`
		2292	`case special_tag:{`
2	7u83	2293	`return zeroneeds;`
		2294	`}`
7	7u83	2295
2	7u83	2296	`default: {`
7	7u83	2297	`printf("case %d not covered in needs scan\n", name(* e));`
2	7u83	2298	`/* NB should call failer */`
		2299	`return zeroneeds;`
		2300	`}`
		2301	`}`
		2302	`}`
		2303
		2304
		2305
		2306
		2307
		2308
		2309
		2310
		2311
		2312

Subversion Repositories tendra.SVN

(root)/branches/algol60/src/installers/alpha/common/scan.c – Rev 7