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

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

Subversion Repositories tendra.SVN

(root)/branches/tendra4/src/installers/alpha/common/scan.c – Rev 3