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

Subversion Repositories tendra.SVN

(root)/branches/algol60/src/installers/mips/common/needs_scan.c – Rev 91