WebSVN – tendra.SVN – Blame – /branches/tendra5-amd64/src/installers/680x0/common/weights.c

Rev	Author	Line No.	Line
2	7u83	1	`/*`
6	7u83	2	`* Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.`
		3	`* All rights reserved.`
		4	`*`
		5	`* Redistribution and use in source and binary forms, with or without`
		6	`* modification, are permitted provided that the following conditions are met:`
		7	`*`
		8	`* 1. Redistributions of source code must retain the above copyright notice,`
		9	`* this list of conditions and the following disclaimer.`
		10	`* 2. Redistributions in binary form must reproduce the above copyright notice,`
		11	`* this list of conditions and the following disclaimer in the documentation`
		12	`* and/or other materials provided with the distribution.`
		13	`* 3. Neither the name of The TenDRA Project nor the names of its contributors`
		14	`* may be used to endorse or promote products derived from this software`
		15	`* without specific, prior written permission.`
		16	`*`
		17	* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
		18	`* IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,`
		19	`* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR`
		20	`* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR`
		21	`* CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,`
		22	`* EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,`
		23	`* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;`
		24	`* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,`
		25	`* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR`
		26	`* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF`
		27	`* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.`
		28	`*`
		29	`* $Id$`
		30	`*/`
		31	`/*`
2	7u83	32	`Crown Copyright (c) 1996`
		33
		34	`This TenDRA(r) Computer Program is subject to Copyright`
		35	`owned by the United Kingdom Secretary of State for Defence`
		36	`acting through the Defence Evaluation and Research Agency`
		37	`(DERA). It is made available to Recipients with a`
		38	`royalty-free licence for its use, reproduction, transfer`
		39	`to other parties and amendment for any purpose not excluding`
		40	`product development provided that any such use et cetera`
		41	`shall be deemed to be acceptance of the following conditions:-`
		42
		43	`(1) Its Recipients shall ensure that this Notice is`
		44	`reproduced upon any copies or amended versions of it;`
		45
		46	`(2) Any amended version of it shall be clearly marked to`
		47	`show both the nature of and the organisation responsible`
		48	`for the relevant amendment or amendments;`
		49
		50	`(3) Its onward transfer from a recipient to another`
		51	`party shall be deemed to be that party's acceptance of`
		52	`these conditions;`
		53
		54	`(4) DERA gives no warranty or assurance as to its`
		55	`quality or suitability for any purpose and DERA accepts`
		56	`no liability whatsoever in relation to any use to which`
		57	`it may be put.`
		58	`*/`
		59	`/*`
		60	`VERSION INFORMATION`
		61	`===================`
		62
		63	`--------------------------------------------------------------------------`
		64	$Header: /u/g/release/CVSROOT/Source/src/installers/680x0/common/weights.c,v 1.1.1.1 1998/01/17 15:55:50 release Exp $
		65	`--------------------------------------------------------------------------`
		66	$Log: weights.c,v $
		67	`* Revision 1.1.1.1 1998/01/17 15:55:50 release`
		68	`* First version to be checked into rolling release.`
		69	`*`
		70	`Revision 1.1.1.1 1997/10/13 12:43:00 ma`
		71	`First version.`
		72
		73	`Revision 1.3 1997/09/25 06:45:40 ma`
		74	`All general_proc tests passed`
		75
		76	`Revision 1.2 1997/04/20 11:30:41 ma`
		77	`Introduced gcproc.c & general_proc.[ch].`
		78	`Added cases for apply_general_proc next to apply_proc in all files.`
		79
		80	`Revision 1.1.1.1 1997/03/14 07:50:20 ma`
		81	`Imported from DRA`
		82
		83	`* Revision 1.1.1.1 1996/09/20 10:57:00 john`
		84	`*`
		85	`* Revision 1.2 1996/07/05 14:29:51 john`
		86	`* Changes for spec 3.1`
		87	`*`
		88	`* Revision 1.1.1.1 1996/03/26 15:45:19 john`
		89	`*`
		90	`* Revision 1.2 94/02/21 16:06:14 16:06:14 ra (Robert Andrews)`
		91	`* Put in an explicit cast.`
		92	`*`
		93	`* Revision 1.1 93/02/22 17:16:59 17:16:59 ra (Robert Andrews)`
		94	`* Initial revision`
		95	`*`
		96	`--------------------------------------------------------------------------`
		97	`*/`
		98
		99
		100	`#include "config.h"`
		101	`#include "common_types.h"`
		102	`#include "exp.h"`
		103	`#include "expmacs.h"`
		104	`#include "externs.h"`
		105	`#include "shapemacs.h"`
		106	`#include "tags.h"`
		107	`#include "tests.h"`
		108	`#include "utility.h"`
		109	`#include "mach.h"`
		110	`#include "where.h"`
		111	`#include "translate.h"`
		112	`#include "weights.h"`
		113
		114
		115	`/*`
		116	`CONTROL MACROS`
		117	`*/`
		118
		119	`#define AVERAGE_LOOP_LENGTH 10`
		120
		121
		122	`/*`
		123	`MAXIMUM AND MINIMUM WEIGHTS`
		124	`*/`
		125
6	7u83	126	`#define cant_use ((float) -1.0e10)`
2	7u83	127
		128
		129	`/*`
		130	`NUMBERS OF AVAILABLE REGISTERS`
		131	`*/`
		132
		133	`#define wdno 16`
		134	`#define wano 16`
		135	`#define wfno 6`
6	7u83	136	`#define wno (wdno + wano + wfno)`
2	7u83	137
		138
		139	`/*`
		140	`STRUCTURE DEFINITIONS OF weights, wp, explist`
		141	`*/`
		142
		143	`typedef struct {`
6	7u83	144	`float wts[wno];`
		145	`long d_used;`
		146	`long a_used;`
		147	`long f_used;`
		148	`} weights;`
2	7u83	149
		150	`typedef struct {`
6	7u83	151	`weights wt;`
		152	`long bkpt;`
		153	`} wp;`
2	7u83	154
		155	`typedef struct elt {`
6	7u83	156	`exp member;`
		157	`struct elt *next;`
		158	`} explist ;`
2	7u83	159
		160
		161	`/*`
		162	`BASIC WEIGHTS`
		163	`*/`
		164
6	7u83	165	`static weights zeros;`
		166	`static weights weightsv(exp, explist *);`
2	7u83	167
		168
		169	`/*`
		170	`CURRENT WEIGHTS SCALE FACTOR`
		171	`*/`
		172
6	7u83	173	`static float scale;`
2	7u83	174
		175
		176	`/*`
		177	`ADD TWO WEIGHT VECTORS`
		178	`*/`
		179
		180	`static weights add_weights`
6	7u83	181	`(weights w1, weights w2)`
2	7u83	182	`{`
6	7u83	183	`long i;`
		184	`weights r;`
		185	`float wa, wb;`
		186	`for (i = 0; i < wno; i++) {`
		187	`wa = (w1.wts)[i];`
		188	`wb = (w2.wts)[i];`
		189	`if (wa == cant_use \|\| wb == cant_use) {`
		190	`(r.wts)[i] = cant_use;`
2	7u83	191	`} else {`
6	7u83	192	`(r.wts)[i] = wa + wb;`
2	7u83	193	`}`
		194	`}`
6	7u83	195	`r.d_used = maximum(w1.d_used, w2.d_used);`
		196	`r.a_used = maximum(w1.a_used, w2.a_used);`
		197	`r.f_used = maximum(w1.f_used, w2.f_used);`
		198	`return(r);`
2	7u83	199	`}`
		200
		201
		202	`/*`
		203	`INITIALIZE BASIC WEIGHTS`
		204	`*/`
		205
		206	`void init_weights`
6	7u83	207	`(void)`
2	7u83	208	`{`
6	7u83	209	`long i;`
		210	`for (i = 0; i < wno; i++)(zeros.wts)[i] = (float)0.0;`
		211	`zeros.d_used = -1;`
		212	`zeros.a_used = -1;`
		213	`zeros.f_used = -1;`
		214	`return;`
2	7u83	215	`}`
		216
		217
		218	`/*`
		219	`MARK A LIST OF EXPS`
		220	`*/`
		221
		222	`static void markcall`
6	7u83	223	`(explist *el, bitpattern b)`
2	7u83	224	`{`
6	7u83	225	`explist *t;`
		226	`for (t = el; t != null; t = t->next)props(t->member) \|= b;`
		227	`return;`
2	7u83	228	`}`
		229
		230
		231	`/*`
		232	`WORK OUT WEIGHTS FOR A DECLARATION`
		233	`*/`
		234
		235	`static wp max_weights`
6	7u83	236	`(long s, float locp, weights ws, int rtype)`
2	7u83	237	`{`
6	7u83	238	`wp res;`
		239	`bool bkset = 0;`
		240	`long i, n;`
		241	`long sz = (s + 31) / 32, bk = 1;`
		242	`long q = 0;`
		243	`float w, pw;`
		244	`long used, total, offset;`
2	7u83	245
		246	`/* Find values for this register type */`
6	7u83	247	`switch (rtype) {`
2	7u83	248
6	7u83	249	`case Dreg: {`
		250	`offset = 0;`
		251	`total = wdno;`
		252	`used = ws.d_used;`
		253	`break;`
2	7u83	254	`}`
		255
6	7u83	256	`case Areg: {`
		257	`offset = wdno;`
		258	`total = wano;`
		259	`used = ws.a_used;`
		260	`break;`
2	7u83	261	`}`
		262
6	7u83	263	`case Freg: {`
		264	`offset = wdno + wano;`
		265	`total = wfno;`
		266	`used = ws.f_used;`
		267	`break;`
2	7u83	268	`}`
		269
		270	`default : {`
6	7u83	271	`error("Illegal register type");`
		272	`exit(EXIT_FAILURE);`
2	7u83	273	`}`
		274	`}`
6	7u83	275	`w = & (ws.wts)[offset];`
		276	`pw = & ((res.wt).wts)[offset];`
		277	`n = used + sz + 1;`
		278	`if (n > total)n = total;`
2	7u83	279
		280	`/* Copy ws to res.wt */`
6	7u83	281	`for (i = 0; i < wno; i++)((res.wt).wts)[i] = (ws.wts)[i];`
		282	`res.wt.d_used = ws.d_used;`
		283	`res.wt.a_used = ws.a_used;`
		284	`res.wt.f_used = ws.f_used;`
2	7u83	285
6	7u83	286	`if (locp == cant_use) {`
		287	`for (i = 0; i < n; i++)pw[i] = cant_use;`
		288	`for (i = n; i < total; i++)pw[i] = w[i];`
		289	`switch (rtype) {`
		290	`case Dreg: res.wt.d_used = ws.d_used + sz; break;`
		291	`case Areg: res.wt.a_used = ws.a_used + sz; break;`
		292	`case Freg: res.wt.f_used = ws.f_used + sz; break;`
2	7u83	293	`}`
6	7u83	294	`bk = 0;`
2	7u83	295	`} else {`
6	7u83	296	`float loc = locp *((float)sz);`
		297	`q = -1;`
		298	`for (i = 0; i < total; i++) {`
		299	`if (w[i] == cant_use) {`
		300	`pw[i] = cant_use;`
		301	`q = i;`
2	7u83	302	`} else {`
6	7u83	303	`if (i < (sz + q)) {`
		304	`pw[i] = w[i];`
2	7u83	305	`} else {`
6	7u83	306	`if (i == (sz + q)) {`
		307	`if (loc >= w[i] && used <= q) {`
		308	`pw[i] = loc;`
		309	`bk = i + 1;`
		310	`bkset = 1;`
2	7u83	311	`} else {`
6	7u83	312	`pw[i] = w[i];`
2	7u83	313	`}`
		314	`} else {`
6	7u83	315	`float z = loc + w[i - sz];`
		316	`if (z >= w[i]) {`
		317	`pw[i] = z;`
		318	`if (!bkset) { bk = i + 1; bkset = 1; }`
2	7u83	319	`} else {`
6	7u83	320	`pw[i] = w[i];`
2	7u83	321	`}`
		322	`}`
		323	`}`
		324	`}`
		325	`}`
		326	`}`
		327	`/* Set the breakpoint */`
6	7u83	328	`res.bkpt = bk;`
		329	`return(res);`
2	7u83	330	`}`
		331
		332
		333	`/*`
		334	`WORK OUT WEIGHTS FOR A LIST OF EXPS`
		335	`*/`
		336
		337	`static weights add_wlist`
6	7u83	338	`(exp re, explist *el)`
2	7u83	339	`{`
6	7u83	340	`weights wl1, wl2;`
		341	`if (re == nilexp) return(zeros);`
2	7u83	342
6	7u83	343	`wl1 = weightsv(re, el);`
2	7u83	344
6	7u83	345	`while (!last(re)) {`
		346	`re = bro(re);`
		347	`wl2 = weightsv(re, el);`
		348	`wl1 = add_weights(wl1, wl2);`
2	7u83	349	`}`
6	7u83	350	`return(wl1);`
2	7u83	351	`}`
		352
		353
		354	`/*`
		355	`IS X AN ASSIGNMENT?`
		356	`*/`
		357
6	7u83	358	`#define ass(X) (name(X) == ass_tag \|\| name(X) == assvol_tag)`
2	7u83	359
		360
		361	`/*`
		362	`WORK OUT WEIGHTS FOR e SCALED BY scale AND SET BREAK POINTS`
		363	`*/`
		364
		365	`static weights weightsv`
6	7u83	366	`(exp e, explist *el)`
2	7u83	367	`{`
6	7u83	368	`unsigned char n = name(e);`
		369	`switch (n) {`
2	7u83	370
6	7u83	371	`case name_tag: {`
		372	`if (!isglob(son(e)))fno(son(e)) += scale;`
2	7u83	373	`/* Add value to the no field of the declaration */`
6	7u83	374	`return(zeros);`
2	7u83	375	`}`
		376
6	7u83	377	`case make_lv_tag: {`
		378	`return(zeros);`
2	7u83	379	`}`
		380
6	7u83	381	`case ident_tag: {`
		382	`wp p;`
		383	`long sz;`
		384	`shape sha;`
2	7u83	385
		386	`/* Starting point for pt list */`
6	7u83	387	`exp t = pt(e);`
		388	`exp d = son(e);`
2	7u83	389
		390	`/* Add e to the list of exps */`
6	7u83	391	`explist nel;`
		392	`nel.member = e;`
		393	`nel.next = el;`
2	7u83	394
6	7u83	395	`while (isvar(e) && !isvis(e) && t != nilexp) {`
2	7u83	396	`/* Scan along pt list */`
6	7u83	397	`if (!(last(t) && name(bro(t)) == cont_tag) &&`
		398	`!(last(bro(t)) &&`
		399	`ass(bro(bro(t)))))`
2	7u83	400	`/* Make sure it will not go in register */`
6	7u83	401	`setvis(e);`
		402	`t = pt(t);`
2	7u83	403	`}`
		404
6	7u83	405	`if (d != nilexp) {`
		406	`int sht;`
		407	`weights wdef, wbody;`
		408	`fno(e) = (float)0.0;`
2	7u83	409
		410	`/* Work out weights for the body */`
6	7u83	411	`wbody = weightsv(bro(d), &nel);`
2	7u83	412
		413	`/* Work out weights for the definition */`
6	7u83	414	`if (name(d) == clear_tag) {`
		415	`wdef = zeros;`
2	7u83	416	`} else {`
6	7u83	417	`float old_scale = scale;`
		418	`if (name(d) == name_tag)scale = fno(e);`
		419	`wdef = weightsv(d, el);`
		420	`scale = old_scale;`
2	7u83	421	`}`
		422
		423	`/* Shape information */`
6	7u83	424	`sha = sh(d);`
		425	`sz = shape_size(sha);`
		426	`sht = shtype(sha);`
2	7u83	427
		428	`#if 0`
		429	`/* Correct producer bug */`
6	7u83	430	`if (name(sha) == slonghd && name(d) == val_tag &&`
		431	`no(d) == 0) {`
		432	`bool fix = 0;`
		433	`t = pt(e);`
		434	`while (t != nilexp) {`
		435	`exp f = father(t);`
		436	`if (name(f) == cont_tag &&`
		437	`name(sh(f)) == ptrhd)fix = 1;`
		438	`t = (last(t)? nilexp : pt(t));`
2	7u83	439	`}`
6	7u83	440	`if (fix) {`
		441	`sh(d) = ptr_shape(sha);`
		442	`sht = Areg;`
2	7u83	443	`}`
		444	`}`
		445	`#endif`
		446
6	7u83	447	`if (isusereg(e)) {`
2	7u83	448	`/* Work out breakpoint */`
6	7u83	449	`p = max_weights(sz, cant_use, wbody, sht);`
		450	`no(e) = p.bkpt;`
		451	`if (no(e) == 13)error("Bad breakpoint");`
		452	`return(add_weights(wdef, p.wt));`
2	7u83	453	`}`
		454
6	7u83	455	`if (regable(e)) {`
2	7u83	456	`/* Work out breakpoint */`
6	7u83	457	`float loc = fno(e);`
		458	`if (name(d) == name_tag && isusereg(e)) {`
		459	`loc = (float)1.0;`
2	7u83	460	`}`
6	7u83	461	`p = max_weights(sz, loc, wbody, sht);`
		462	`no(e) = p.bkpt;`
		463	`return(add_weights(wdef, p.wt));`
2	7u83	464	`}`
		465
6	7u83	466	`no(e) = 16;`
		467	`return(add_weights(wdef, wbody));`
2	7u83	468	`}`
6	7u83	469	`return(zeros);`
2	7u83	470	`}`
		471
6	7u83	472	`case labst_tag: {`
2	7u83	473	`/* Add e to list of exps */`
6	7u83	474	`explist nel;`
		475	`nel.member = e;`
		476	`nel.next = el;`
		477	`if (regable(e)) {`
		478	`weights wbody;`
		479	`float old_scale = scale;`
		480	`scale = fno(e);`
		481	`wbody = weightsv(bro(son(e)), &nel);`
		482	`scale = old_scale;`
		483	`return(wbody);`
2	7u83	484	`} else {`
6	7u83	485	`return(add_wlist(bro(son(e)), &nel));`
2	7u83	486	`}`
		487	`}`
		488
6	7u83	489	`case rep_tag: {`
		490	`weights swl, bwl;`
		491	`swl = weightsv(son(e), el);`
		492	`bwl = weightsv(bro(son(e)), el);`
		493	`return(add_weights(swl, bwl));`
2	7u83	494	`}`
		495
6	7u83	496	`case compound_tag: {`
		497	`return(add_wlist(son(e), el));`
2	7u83	498	`}`
		499
6	7u83	500	`case untidy_return_tag:`
		501	`case case_tag:`
		502	`case res_tag: {`
		503	`return(weightsv(son(e), el));`
2	7u83	504	`}`
6	7u83	505	`case apply_general_tag:`
		506	`case apply_tag:`
		507	`case round_tag:`
		508	`case float_tag: {`
		509	`markcall(el,(bitpattern)0x80);`
		510	`return(add_wlist(son(e), el));`
2	7u83	511	`}`
		512
6	7u83	513	`case ass_tag:`
		514	`case assvol_tag: {`
		515	`weights swl, bwl;`
		516	`swl = weightsv(son(e), el);`
		517	`bwl = weightsv(bro(son(e)), el);`
		518	`return(add_weights(swl, bwl));`
2	7u83	519	`}`
		520
6	7u83	521	`case general_proc_tag:`
		522	`case proc_tag: {`
		523	`weightsv(son(e), null);`
		524	`return(zeros);`
2	7u83	525	`}`
		526
6	7u83	527	`case env_offset_tag: {`
		528	`return(zeros);`
2	7u83	529	`}`
		530
6	7u83	531	`case val_tag:`
		532	`case real_tag: {`
		533	`return(zeros);`
2	7u83	534	`}`
		535
6	7u83	536	`case test_tag: {`
		537	`weights twl;`
		538	`twl = add_wlist(son(e), el);`
2	7u83	539	`/* scale = scale * ( ( ( float ) 1.0 ) - fno ( e ) ) ; */`
6	7u83	540	`return(twl);`
2	7u83	541	`}`
		542
		543	`default : {`
6	7u83	544	`return(add_wlist(son(e), el));`
2	7u83	545	`}`
		546	`}`
		547	`}`
		548
		549
		550	`/*`
		551	`COMPUTE WEIGHTS`
		552	`*/`
		553
		554	`void comp_weights`
6	7u83	555	`(exp e)`
2	7u83	556	`{`
6	7u83	557	`scale = (float)1.0;`
		558	`weightsv(e, null);`
		559	`return;`
2	7u83	560	`}`

Subversion Repositories tendra.SVN

(root)/branches/tendra5-amd64/src/installers/680x0/common/weights.c – Rev 6