Subversion Repositories tendra.SVN

Rev

Rev 5 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 5 Rev 6
Line -... Line 1...
-
 
1
/*
-
 
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
 */
1
/*
31
/*
2
    		 Crown Copyright (c) 1997
32
    		 Crown Copyright (c) 1997
3
 
33
 
4
    This TenDRA(r) Computer Program is subject to Copyright
34
    This TenDRA(r) Computer Program is subject to Copyright
5
    owned by the United Kingdom Secretary of State for Defence
35
    owned by the United Kingdom Secretary of State for Defence
Line 7... Line 37...
7
    (DERA).  It is made available to Recipients with a
37
    (DERA).  It is made available to Recipients with a
8
    royalty-free licence for its use, reproduction, transfer
38
    royalty-free licence for its use, reproduction, transfer
9
    to other parties and amendment for any purpose not excluding
39
    to other parties and amendment for any purpose not excluding
10
    product development provided that any such use et cetera
40
    product development provided that any such use et cetera
11
    shall be deemed to be acceptance of the following conditions:-
41
    shall be deemed to be acceptance of the following conditions:-
12
 
42
 
13
        (1) Its Recipients shall ensure that this Notice is
43
        (1) Its Recipients shall ensure that this Notice is
14
        reproduced upon any copies or amended versions of it;
44
        reproduced upon any copies or amended versions of it;
15
 
45
 
16
        (2) Any amended version of it shall be clearly marked to
46
        (2) Any amended version of it shall be clearly marked to
17
        show both the nature of and the organisation responsible
47
        show both the nature of and the organisation responsible
Line 23... Line 53...
23
 
53
 
24
        (4) DERA gives no warranty or assurance as to its
54
        (4) DERA gives no warranty or assurance as to its
25
        quality or suitability for any purpose and DERA accepts
55
        quality or suitability for any purpose and DERA accepts
26
        no liability whatsoever in relation to any use to which
56
        no liability whatsoever in relation to any use to which
27
        it may be put.
57
        it may be put.
28
*/
58
*/
29
 
59
 
30
 
60
 
31
/**********************************************************************
61
/**********************************************************************
32
$Author: release $
62
$Author: release $
33
$Date: 1998/01/17 15:56:07 $
63
$Date: 1998/01/17 15:56:07 $
34
$Revision: 1.1.1.1 $
64
$Revision: 1.1.1.1 $
35
$Log: weights.c,v $
65
$Log: weights.c,v $
Line 100... Line 130...
100
};
130
};
101
 
131
 
102
/* NB scale, throughout,  should be a float but mips cc V2.10 compiles calls and
132
/* NB scale, throughout,  should be a float but mips cc V2.10 compiles calls and
103
		proc body inconsistently !! */
133
		proc body inconsistently !! */
104
 
134
 
105
weights weightsv PROTO_S ((double scale, exp e));
135
weights weightsv(double scale, exp e);
106
 
136
 
107
weights add_weights
137
weights add_weights
108
    PROTO_N ( (w1,w2) )
-
 
109
    PROTO_T ( weights * w1 X weights * w2 )
138
(weights * w1, weights * w2)
110
{
139
{
111
				/* sum of weights*/
140
				/* sum of weights*/
112
  weights r;
141
  weights r;
113
  long  i;
142
  long  i;
114
  for (i = 0; i < wfixno; ++i) {
143
  for (i = 0; i < wfixno; ++i) {
115
      (r.fix)[i] = (w1->fix)[i]+(w2->fix)[i];
144
     (r.fix)[i] = (w1->fix)[i] + (w2->fix)[i];
116
  };
145
  };
117
  for (i = 0; i < wfloatno; ++i) {
146
  for (i = 0; i < wfloatno; ++i) {
118
      (r.floating)[i] = (w1->floating)[i]+(w2->floating)[i];
147
     (r.floating)[i] = (w1->floating)[i] + (w2->floating)[i];
119
  };
148
  };
120
  return (r);
149
  return(r);
121
}
150
}
122
 
151
 
123
wp max_weights
152
wp max_weights
124
    PROTO_N ( (loc, ws, fix) )
-
 
125
    PROTO_T ( double loc X weights * ws X bool fix )
153
(double loc, weights * ws, bool fix)
126
{
154
{
127
				/* loc is the usage count of a tag, ws is
155
				/* loc is the usage count of a tag, ws is
128
				   the weights computed for the scope of
156
				   the weights computed for the scope of
129
				   the tag and fix distinguishes between
157
				   the tag and fix distinguishes between
130
				   fix and float. This computes the
158
				   fix and float. This computes the
Line 140... Line 168...
140
 
168
 
141
  long  i;
169
  long  i;
142
  float *w = (ws -> fix);
170
  float *w = (ws -> fix);
143
  /*  w[i] = greatest usage of (i+1) inner fixed tags  */
171
  /*  w[i] = greatest usage of (i+1) inner fixed tags  */
144
  wp res;
172
  wp res;
145
  float *pw = &(((res.wp_weights).fix)[0]);
173
  float *pw = & (((res.wp_weights).fix)[0]);
146
  if (fix) {
174
  if (fix) {
147
    for (i = 0; i < wfixno; ++i) {
175
    for (i = 0; i < wfixno; ++i) {
148
      if (i == 0) {
176
      if (i == 0) {
149
	if (loc > w[i]) {
177
	if (loc > w[i]) {
150
	  /* this tag has higher usage than any inner one ... */
178
	  /* this tag has higher usage than any inner one ... */
151
	  pw[i] = loc;
179
	  pw[i] = loc;
152
	  bk = i;		/* ... so it's regged in pref to others */
180
	  bk = i;		/* ... so it's regged in pref to others */
153
	}
181
	}
154
	else
182
	else
155
	  pw[i] = w[i];
183
	  pw[i] = w[i];
156
      }
184
      }
157
      else {
185
      else {
158
	if ((loc + w[i - 1]) > w[i]) {
186
	if ((loc + w[i - 1]) > w[i]) {
159
	  /* this tag and i inner ones have higher usage than any other
187
	  /* this tag and i inner ones have higher usage than any other
160
	     (i+1) inner ones ... */
188
	     (i+1) inner ones ... */
Line 179... Line 207...
179
 
207
 
180
  res.fix_break = bk;
208
  res.fix_break = bk;
181
 
209
 
182
  bk = wfloatno + 1;
210
  bk = wfloatno + 1;
183
  w = (ws -> floating);
211
  w = (ws -> floating);
184
  pw = &(((res.wp_weights).floating)[0]);
212
  pw = & (((res.wp_weights).floating)[0]);
185
  if (!fix) {			/* same algorithm for float regs as fixed
213
  if (!fix) {			/* same algorithm for float regs as fixed
186
				   regs */
214
				   regs */
187
    for (i = 0; i < wfloatno; ++i) {
215
    for (i = 0; i < wfloatno; ++i) {
188
      if (i == 0) {
216
      if (i == 0) {
189
	if (loc > w[i]) {
217
	if (loc > w[i]) {
Line 213... Line 241...
213
  res.float_break = bk;
241
  res.float_break = bk;
214
  return res;
242
  return res;
215
}
243
}
216
 
244
 
217
weights mult_weights
245
weights mult_weights
218
    PROTO_N ( (m, ws) )
-
 
219
    PROTO_T ( double m X weights * ws )
246
(double m, weights * ws)
220
{
247
{
221
				/* multiply weights by scalar - non
248
				/* multiply weights by scalar - non
222
				   overflowing */
249
				   overflowing */
223
  weights res;
250
  weights res;
224
  float *r = &(res.fix)[0];
251
  float *r = & (res.fix)[0];
225
  float *w = ws -> fix;
252
  float *w = ws -> fix;
226
  long  i;
253
  long  i;
227
  for (i = 0; i < wfixno; ++i) {
254
  for (i = 0; i < wfixno; ++i) {
228
      r[i] = w[i] * m;
255
      r[i] = w[i]* m;
229
  };
256
  };
230
 
257
 
231
  r = &(res.floating)[0];
258
  r = & (res.floating)[0];
232
  w = ws -> floating;
259
  w = ws -> floating;
233
  for (i = 0; i < wfloatno; ++i) {
260
  for (i = 0; i < wfloatno; ++i) {
234
      r[i] = w[i] * m;
261
      r[i] = w[i]* m;
235
  };
262
  };
236
  return (res);
263
  return(res);
237
}
264
}
238
 
265
 
239
weights add_wlist
266
weights add_wlist
240
    PROTO_N ( (scale, re) )
-
 
241
    PROTO_T ( double scale X exp re )
267
(double scale, exp re)
242
{/* sum of  weights of list re */
268
{/* sum of  weights of list re */
243
  weights w, w1;
269
  weights w, w1;
244
  exp r = re;
270
  exp r = re;
245
  if (r == nilexp) {
271
  if (r == nilexp) {
246
    return zeroweights;
272
    return zeroweights;
247
  }
273
  }
248
  else
274
  else
249
    if (last (r)) {
275
    if (last(r)) {
250
      return (weightsv (scale, r));
276
      return(weightsv(scale, r));
251
    }
277
    }
252
    else {
278
    else {
253
      w = weightsv (scale, r);
279
      w = weightsv(scale, r);
254
      do {
280
      do {
255
	r = bro (r);
281
	r = bro(r);
256
	w1 = weightsv (scale, r);
282
	w1 = weightsv(scale, r);
257
	w = add_weights (&w, &w1);
283
	w = add_weights(&w, &w1);
258
      } while (!last (r));
284
      } while (!last(r));
259
      return w;
285
      return w;
260
    }
286
    }
261
}
287
}
262
 
288
 
263
 
289
 
Line 272... Line 298...
272
finally determines the actual choice of s reg and recodes the number
298
finally determines the actual choice of s reg and recodes the number
273
field of an ident.
299
field of an ident.
274
 
300
 
275
******************************************************************/
301
******************************************************************/
276
weights weightsv
302
weights weightsv
277
    PROTO_N ( (scale, e) )
-
 
278
    PROTO_T ( double scale X exp e )
303
(double scale, exp e)
279
{
304
{
280
 unsigned char  n;
305
 unsigned char  n;
281
tailrecurse:
306
tailrecurse:
282
  n = name (e);
307
  n = name(e);
283
  switch (n) {
308
  switch (n) {
284
    case name_tag:
309
    case name_tag:
285
      {
310
      {
286
	exp s = son (e);
311
	exp s = son(e);
287
 
312
 
288
	if (name (s) == ident_tag && !isglob (s)) {
313
	if (name(s) == ident_tag && !isglob(s)) {
289
	  if (is_floating(name(sh(e))) && name(sh(e)) != shrealhd) {
314
	  if (is_floating(name(sh(e))) && name(sh(e))!= shrealhd) {
290
	  	fno(s) += scale*2.0;
315
	  	fno(s) += scale*2.0;
291
	  } else fno (s) += scale;
316
	  } else fno(s) += scale;
292
	}
317
	}
293
	/* usage of tag stored in number of son of load_name (decl) */
318
	/* usage of tag stored in number of son of load_name (decl) */
294
	return zeroweights;
319
	return zeroweights;
295
      };
320
      };
296
 
321
 
297
    case ident_tag:
322
    case ident_tag:
298
      {
323
      {
299
	if (son (e) != nilexp) {
324
	if (son(e)!= nilexp) {
300
	  weights wdef;
325
	  weights wdef;
301
	  weights wbody;
326
	  weights wbody;
302
	  long  noe = no (e) /* set by scan */ ;
327
	  long  noe = no (e) /* set by scan */ ;
303
 
328
 
304
	  if (name (son (e)) == clear_tag || props (e) & defer_bit) {
329
	  if (name(son(e)) == clear_tag || props(e) & defer_bit) {
305
	    wdef = zeroweights;
330
	    wdef = zeroweights;
306
	    fno(e)= 0.0;
331
	    fno(e) = 0.0;
307
	  }
332
	  }
308
	  else {
333
	  else {
309
	    /* maybe needs a store to initialise */
334
	    /* maybe needs a store to initialise */
310
	    if (is_floating(name(sh(son(e)))) && name(sh(son(e))) != shrealhd) {
335
	    if (is_floating(name(sh(son(e)))) && name(sh(son(e)))!= shrealhd) {
311
	  		fno(e) = scale*2.0;
336
	  		fno(e) = scale*2.0;
312
	    } else fno (e) = scale;
337
	    } else fno(e) = scale;
313
	    wdef = weightsv (scale, son (e));
338
	    wdef = weightsv(scale, son(e));
314
	  }
339
	  }
315
	  /* weights for initialisation of dec */
340
	  /* weights for initialisation of dec */
316
 
341
 
317
	  wbody = weightsv (scale, bro (son (e)));
342
	  wbody = weightsv(scale, bro(son(e)));
318
	  /* weights of body of scan */
343
	  /* weights of body of scan */
319
 
344
 
320
	  if (props (e) & defer_bit) {/* declaration will be treated
345
	  if (props (e) & defer_bit) {/* declaration will be treated
321
				   transparently in code production */
346
				   transparently in code production */
322
	    exp t = son (e);
347
	    exp t = son(e);
323
	    exp s;
348
	    exp s;
324
	    if (name (t) == val_tag || name(t) == real_tag) {
349
	    if (name(t) == val_tag || name(t) == real_tag) {
325
	      return wbody;
350
	      return wbody;
326
	    }
351
	    }
327
	    while (name (t) != name_tag) {
352
	    while (name(t)!= name_tag) {
328
	      t = son (t);
353
	      t = son(t);
329
	    }
354
	    }
330
 
355
 
331
	    s = son (t);
356
	    s = son(t);
332
	    if (name (s) == ident_tag && !isglob (t)) {
357
	    if (name(s) == ident_tag && !isglob(t)) {
333
	      fno (s) += fno (e);
358
	      fno(s) += fno(e);
334
	    }
359
	    }
335
	    /* usage of tag stored in number of son of load_name (decl) */
360
	    /* usage of tag stored in number of son of load_name (decl) */
336
 
361
 
337
	    return wbody;
362
	    return wbody;
338
	  }			/* end deferred */
363
	  }			/* end deferred */
339
 
364
 
340
	  if ((props (e) & inreg_bits) == 0 && fixregable (e)) {
365
	  if ((props(e) & inreg_bits) == 0 && fixregable(e)) {
341
	    wp p;
366
	    wp p;
342
	    p = max_weights (fno (e) - 2.0*scale , &wbody, 1);
367
	    p = max_weights(fno(e) - 2.0*scale , &wbody, 1);
343
	    /* usage decreased by 2 because of dump and restore of s-reg
368
	    /* usage decreased by 2 because of dump and restore of s-reg
344
	    */
369
	    */
345
	    no (e) = p.fix_break;
370
	    no(e) = p.fix_break;
346
	    return (add_weights (&wdef, &p.wp_weights));
371
	    return(add_weights(&wdef, &p.wp_weights));
347
	  }
372
	  }
348
	  else
373
	  else
349
	    if ((props (e) & infreg_bits) == 0 && floatregable (e)) {
374
	    if ((props(e) & infreg_bits) == 0 && floatregable(e)) {
350
	      wp p;
375
	      wp p;
351
	      p = max_weights (fno (e) - 4 * scale, &wbody, 0);
376
	      p = max_weights(fno(e) - 4 * scale, &wbody, 0);
352
	      /* usage decreased by 4 because of dump and restore of
377
	      /* usage decreased by 4 because of dump and restore of
353
	         double s-reg */
378
	         double s-reg */
354
	      no (e) = p.float_break;
379
	      no(e) = p.float_break;
355
	      return (add_weights (&wdef, &p.wp_weights));
380
	      return(add_weights(&wdef, &p.wp_weights));
356
	    }
381
	    }
357
	    else {
382
	    else {
358
	      no (e) = noe /* restore to value given by scan */ ;
383
	      no (e) = noe /* restore to value given by scan */ ;
359
	      return add_weights (&wdef, &wbody);
384
	      return add_weights(&wdef, &wbody);
360
	    }
385
	    }
361
	}
386
	}
362
	else
387
	else
363
	  return zeroweights;
388
	  return zeroweights;
364
      };
389
      };
365
    case rep_tag: {
390
    case rep_tag: {
366
	e = bro (son (e));
391
	e = bro(son(e));
367
	goto tailrecurse;
392
	goto tailrecurse;
368
      }
393
      }
369
 
394
 
370
    case case_tag: {
395
    case case_tag: {
371
	e = son (e);
396
	e = son(e);
372
	goto tailrecurse;
397
	goto tailrecurse;
373
      };
398
      };
374
 
399
 
375
    case labst_tag:
400
    case labst_tag:
376
      { scale = fno(e);
401
      { scale = fno(e);
377
	e = bro (son (e));
402
	e = bro(son(e));
378
	goto tailrecurse;
403
	goto tailrecurse;
379
      }
404
      }
380
 
405
 
381
 
406
 
382
    case val_tag:{
407
    case val_tag:{
Line 392... Line 417...
392
    case seq_tag:  {
417
    case seq_tag:  {
393
	exp l = son(son(e));
418
	exp l = son(son(e));
394
	exp r = bro(son(e));
419
	exp r = bro(son(e));
395
	weights w, w1;
420
	weights w, w1;
396
        w = weightsv(scale, l);
421
        w = weightsv(scale, l);
397
	while(!last(l)) {
422
	while (!last(l)) {
398
		l = bro(l);
423
		l = bro(l);
399
		w1 = weightsv(scale, l);
424
		w1 = weightsv(scale, l);
400
		w = add_weights(&w, &w1);
425
		w = add_weights(&w, &w1);
401
	}
426
	}
402
	w1 = weightsv(scale, r);
427
	w1 = weightsv(scale, r);
Line 404... Line 429...
404
        return w;
429
        return w;
405
   }
430
   }
406
 
431
 
407
 
432
 
408
    default: {
433
    default: {
409
	if (son (e) == nilexp || n == env_offset_tag
434
	if (son(e) == nilexp || n == env_offset_tag
410
		|| n == general_env_offset_tag ) {
435
		|| n == general_env_offset_tag) {
411
	  return zeroweights;
436
	  return zeroweights;
412
	}
437
	}
413
	if (last (son (e))) {
438
	if (last(son(e))) {
414
	  e = son (e);
439
	  e = son(e);
415
	  goto tailrecurse;
440
	  goto tailrecurse;
416
	}
441
	}
417
	return (add_wlist (scale, son (e)));
442
	return(add_wlist(scale, son(e)));
418
      }
443
      }
419
  }
444
  }
420
}
445
}